From 3dc3871463cda8c9e75e56cdfa309cd694b50e3f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 11 Mar 2024 17:07:27 +0100 Subject: [PATCH 001/108] List-ref and cad*r deforestation Deforest all variants of cad*r: - car - cadr - caddr - cadddr - caddddr - cadddddr Deforest (using the same underlying implementation) list-ref as well. --- qi-lib/flow/core/deforest.rkt | 38 +++++++++++++++++++++++++---------- 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt index 71e35896a..bd45049db 100644 --- a/qi-lib/flow/core/deforest.rkt +++ b/qi-lib/flow/core/deforest.rkt @@ -129,6 +129,15 @@ [else (λ (ctx name) #'(λ (v) v))])])) + (define-syntax-class cad*r-datum + #:attributes (countdown) + (pattern (~datum car) #:attr countdown #'0) + (pattern (~datum cadr) #:attr countdown #'1) + (pattern (~datum caddr) #:attr countdown #'2) + (pattern (~datum cadddr) #:attr countdown #'3) + (pattern (~datum caddddr) #:attr countdown #'4) + (pattern (~datum cadddddr) #:attr countdown #'5)) + ;; 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 @@ -238,14 +247,18 @@ _))) #:attr end #'(foldl-cstream-next op init)) - (pattern (~or (esc (#%host-expression (~datum car))) + (pattern (~or (esc (#%host-expression cad*r:cad*r-datum)) (#%fine-template - ((#%host-expression (~datum car)) - _)) + ((#%host-expression cad*r:cad*r-datum) _)) + (#%blanket-template + ((#%host-expression cad*r:cad*r-datum) __))) + #:attr end #'(cad*r-cstream-next cad*r.countdown)) + + (pattern (~or (#%fine-template + ((#%host-expression (~datum list-ref)) _ idx)) (#%blanket-template - ((#%host-expression (~datum car)) - __))) - #:attr end #'(car-cstream-next)) + ((#%host-expression (~datum list-ref)) __ idx))) + #:attr end #'(cad*r-cstream-next idx)) (pattern (~literal cstream->list) #:attr end #'(cstream-next->list))) @@ -407,16 +420,19 @@ (loop (op value acc) state))) state)))) - (define-inline (car-cstream-next next ctx src) + (define-inline (cad*r-cstream-next init-countdown next ctx src) (λ (state) - (let loop ([state state]) + (let loop ([state state] + [countdown init-countdown]) ((next (λ () ((contract (-> pair? any) (λ (v) v) - 'car-cstream-next ctx #f + 'cad*r-cstream-next ctx #f src) '())) - (λ (state) (loop state)) + (λ (state) (loop state countdown)) (λ (value state) - value)) + (if (zero? countdown) + value + (loop state (sub1 countdown))))) state)))) ) From 83384fbcd3a0cb0e116abd4d010ebec77bba5e9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 23 Mar 2024 15:50:42 +0100 Subject: [PATCH 002/108] Deforestation of length, empty?, and null?. --- qi-lib/flow/core/deforest.rkt | 37 +++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt index bd45049db..038da6879 100644 --- a/qi-lib/flow/core/deforest.rkt +++ b/qi-lib/flow/core/deforest.rkt @@ -260,6 +260,25 @@ ((#%host-expression (~datum list-ref)) __ idx))) #:attr end #'(cad*r-cstream-next idx)) + (pattern (~or (esc + (#%host-expression (~datum length))) + (#%fine-template + ((#%host-expression (~datum length)) _)) + (#%blanket-template + ((#%host-expression (~datum length)) __))) + #:attr end #'(length-cstream-next)) + + (pattern (~or (esc + (#%host-expression (~or (~datum empty?) + (~datum null?)))) + (#%fine-template + ((#%host-expression (~or (~datum empty?) + (~datum null?))) _)) + (#%blanket-template + ((#%host-expression (~or (~datum empty?) + (~datum null?))) __))) + #:attr end #'(empty?-cstream-next)) + (pattern (~literal cstream->list) #:attr end #'(cstream-next->list))) @@ -435,4 +454,22 @@ (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)))) + ) From cf0b178e69dccd2ea6cbc48881c28d0f7483fb14 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 23 Mar 2024 16:12:52 +0100 Subject: [PATCH 003/108] Deforest filter-map. --- qi-lib/flow/core/deforest.rkt | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt index 038da6879..d6f06c324 100644 --- a/qi-lib/flow/core/deforest.rkt +++ b/qi-lib/flow/core/deforest.rkt @@ -180,17 +180,17 @@ ;; 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 (~or (~datum filter) + (~datum filter-map))) (#%host-expression f) __)) (#%fine-template - ((#%host-expression (~datum filter)) + ((#%host-expression (~or (~datum filter) + (~datum filter-map))) (#%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` @@ -216,7 +216,17 @@ ((#%host-expression (~datum filter)) (#%host-expression f) _))) - #:attr next #'filter-cstream-next)) + #:attr next #'filter-cstream-next) + + (pattern (~or (#%blanket-template + ((#%host-expression (~datum filter-map)) + (#%host-expression f) + __)) + (#%fine-template + ((#%host-expression (~datum filter-map)) + (#%host-expression f) + _))) + #:attr next #'filter-map-cstream-next)) ;; Terminates the fused sequence (consumes the stream) and produces ;; an actual result value. @@ -410,6 +420,16 @@ (yield value state) (skip state)))))) + (define-inline (filter-map-cstream-next f next) + (λ (done skip yield) + (next done + skip + (λ (value state) + (let ([fv (f value)]) + (if fv + (yield fv state) + (skip state))))))) + ;; Consumers (define-inline (cstream-next->list next ctx src) From 9d9c06479e59d6665b0e5af78e7b7675dc2d25a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 6 Apr 2024 19:01:52 +0200 Subject: [PATCH 004/108] Pass deforested operation name in cad*r-cstream-next. --- qi-lib/flow/core/deforest.rkt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt index d6f06c324..7ee980356 100644 --- a/qi-lib/flow/core/deforest.rkt +++ b/qi-lib/flow/core/deforest.rkt @@ -262,13 +262,13 @@ ((#%host-expression cad*r:cad*r-datum) _)) (#%blanket-template ((#%host-expression cad*r:cad*r-datum) __))) - #:attr end #'(cad*r-cstream-next cad*r.countdown)) + #:attr end #'(cad*r-cstream-next cad*r.countdown 'cad*r)) (pattern (~or (#%fine-template ((#%host-expression (~datum list-ref)) _ idx)) (#%blanket-template ((#%host-expression (~datum list-ref)) __ idx))) - #:attr end #'(cad*r-cstream-next idx)) + #:attr end #'(cad*r-cstream-next idx 'list-ref)) (pattern (~or (esc (#%host-expression (~datum length))) @@ -459,13 +459,13 @@ (loop (op value acc) state))) state)))) - (define-inline (cad*r-cstream-next init-countdown next ctx src) + (define-inline (cad*r-cstream-next init-countdown name next ctx src) (λ (state) (let loop ([state state] [countdown init-countdown]) ((next (λ () ((contract (-> pair? any) (λ (v) v) - 'cad*r-cstream-next ctx #f + name ctx #f src) '())) (λ (state) (loop state countdown)) (λ (value state) From f3152816127fe6f9b78d320b717a61637249c0db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 28 Apr 2024 18:49:05 +0200 Subject: [PATCH 005/108] Fix failing car-deforested? test. --- qi-test/tests/compiler/rules/private/deforest-util.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/qi-test/tests/compiler/rules/private/deforest-util.rkt b/qi-test/tests/compiler/rules/private/deforest-util.rkt index 193a986d8..7746150e7 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) "cad*r-cstream")) From 6df1eca7ab6154b859123a907831aaeff9d793d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 30 Apr 2024 15:34:56 +0200 Subject: [PATCH 006/108] Cleaner syntax matching and production separation. - split syntax matching from syntax production - improve naming of syntax classes - remove unused template variables --- qi-lib/flow/core/deforest-cps.rkt | 323 ++++++++++++++++++ qi-lib/flow/core/deforest-syntax.rkt | 302 ++++++++++++++++ qi-lib/flow/core/deforest-templates.rkt | 10 + .../compiler/rules/private/deforest-util.rkt | 2 +- 4 files changed, 636 insertions(+), 1 deletion(-) create mode 100644 qi-lib/flow/core/deforest-cps.rkt create mode 100644 qi-lib/flow/core/deforest-syntax.rkt create mode 100644 qi-lib/flow/core/deforest-templates.rkt diff --git a/qi-lib/flow/core/deforest-cps.rkt b/qi-lib/flow/core/deforest-cps.rkt new file mode 100644 index 000000000..c834aafa1 --- /dev/null +++ b/qi-lib/flow/core/deforest-cps.rkt @@ -0,0 +1,323 @@ +#lang racket/base + +(provide (for-syntax deforest-pass)) + +(require (for-syntax racket/base + syntax/parse + "deforest-syntax.rkt" + "../extended/util.rkt" + syntax/srcloc + racket/syntax-srcloc) + "deforest-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] rest ...) (op f (inline-compose1 rest ...))])) + +(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) + (pattern filter:fst-filter + #:attr f #'filter.f + #:attr next #'filter-cstream-next) + (pattern map:fst-map + #:attr f #'map.f + #:attr next #'map-cstream-next) + (pattern filter-map:fst-filter-map + #:attr f #'filter-map.f + #:attr next #'filter-map-cstream-next) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; 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. + #`(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)))))]))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 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)))))) + + (define-inline (filter-map-cstream-next f next) + (λ (done skip yield) + (next done + skip + (λ (value state) + (let ([fv (f value)]) + (if fv + (yield fv 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 (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/deforest-syntax.rkt b/qi-lib/flow/core/deforest-syntax.rkt new file mode 100644 index 000000000..790a771b2 --- /dev/null +++ b/qi-lib/flow/core/deforest-syntax.rkt @@ -0,0 +1,302 @@ +#lang racket/base + +(provide fsp-intf + fsp-range + fsp-default + + fst-intf + fst-filter + fst-map + fst-filter-map + fst-take + + fsc-intf + fsc-foldr + fsc-foldl + fsc-list-ref + fsc-length + fsc-empty? + fsc-default + + define-and-register-deforest-pass + ) + +(require syntax/parse + "passes.rkt" + "strategy.rkt" + (for-template racket/base + "passes.rkt" + "strategy.rkt" + "deforest-templates.rkt") + (for-syntax racket/base + syntax/parse)) + +(define-literal-set fs-literals + #:datum-literals (esc #%host-expression #%fine-template #%blanket-template _ __) + ()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Producers + +(define-syntax-class fsp-range + #:attributes (blanket? fine? arg pre-arg post-arg) + #:literal-sets (fs-literals) + #:datum-literals (range) + (pattern (esc (#%host-expression range)) + #:attr arg #f + #:attr pre-arg #f + #:attr post-arg #f + #:attr blanket? #f + #:attr fine? #f) + (pattern (#%fine-template + ((#%host-expression 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 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-intf + (pattern (~or _:fsp-range + _:fsp-default))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Transformers + +(define-syntax-class fst-filter + #:attributes (f) + #:literal-sets (fs-literals) + #:datum-literals (filter) + (pattern (#%blanket-template + ((#%host-expression filter) + (#%host-expression f) + __))) + (pattern (#%fine-template + ((#%host-expression filter) + (#%host-expression f) + _)))) + +(define-syntax-class fst-map + #:attributes (f) + #:literal-sets (fs-literals) + #:datum-literals (map) + (pattern (#%blanket-template + ((#%host-expression map) + (#%host-expression f) + __))) + (pattern (#%fine-template + ((#%host-expression map) + (#%host-expression f) + _)))) + +(define-syntax-class fst-filter-map + #:attributes (f) + #:literal-sets (fs-literals) + #:datum-literals (filter-map) + (pattern (#%blanket-template + ((#%host-expression filter-map) + (#%host-expression f) + __))) + (pattern (#%fine-template + ((#%host-expression filter-map) + (#%host-expression f) + _)))) + +(define-syntax-class fst-take + #:attributes (n) + #:literal-sets (fs-literals) + #:datum-literals (take) + (pattern (#%blanket-template + ((#%host-expression take) + __ + (#%host-expression n)))) + (pattern (#%fine-template + ((#%host-expression take) + _ + (#%host-expression n))))) + +(define-syntax-class fst-intf0 + (pattern (~or filter:fst-filter + filter-map:fst-filter-map))) + +(define-syntax-class fst-intf + (pattern (~or _:fst-filter + _:fst-map + _:fst-filter-map + _:fst-take))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Consumers + +(define-syntax-class fsc-foldr + #:attributes (op init) + #:literal-sets (fs-literals) + #:datum-literals (foldr) + (pattern (#%blanket-template + ((#%host-expression foldr) + (#%host-expression op) + (#%host-expression init) + __))) + (pattern (#%fine-template + ((#%host-expression foldr) + (#%host-expression op) + (#%host-expression init) + _)))) + +(define-syntax-class fsc-foldl + #:attributes (op init) + #:literal-sets (fs-literals) + #:datum-literals (foldl) + (pattern (#%blanket-template + ((#%host-expression foldl) + (#%host-expression op) + (#%host-expression init) + __))) + (pattern (#%fine-template + ((#%host-expression foldl) + (#%host-expression op) + (#%host-expression init) + _)))) + +(define-syntax-class cad*r-datum + #:attributes (countdown) + (pattern (~datum car) #:attr countdown #'0) + (pattern (~datum cadr) #:attr countdown #'1) + (pattern (~datum caddr) #:attr countdown #'2) + (pattern (~datum cadddr) #:attr countdown #'3) + (pattern (~datum caddddr) #:attr countdown #'4) + (pattern (~datum cadddddr) #:attr countdown #'5)) + +(define-syntax-class fsc-list-ref + #:attributes (pos name) + #:literal-sets (fs-literals) + #:datum-literals (list-ref) + (pattern (~or (#%fine-template + ((#%host-expression list-ref) _ idx)) + (#%blanket-template + ((#%host-expression 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) + #:datum-literals (length) + (pattern (esc + (#%host-expression length))) + (pattern (#%fine-template + ((#%host-expression length) _))) + (pattern (#%blanket-template + ((#%host-expression length) __)))) + +(define-syntax-class fsc-empty? + #:literal-sets (fs-literals) + #:datum-literals (empty? null?) + (pattern (esc + (#%host-expression (~or empty? + null?)))) + (pattern (#%fine-template + ((#%host-expression (~or empty? + null?)) _))) + (pattern (#%blanket-template + ((#%host-expression (~or empty? + null?)) __)))) + +(define-syntax-class fsc-default + #:datum-literals (cstream->list) + (pattern cstream->list)) + +(define-syntax-class fsc-intf + (pattern (~or _:fsc-foldr + _:fsc-foldl + _:fsc-list-ref + _:fsc-length + _: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-intf + _:fsp-intf + _:fsc-intf)))) + +(define (make-deforest-rewrite generate-fused-operation) + (lambda (stx) + (syntax-parse stx + [((~datum thread) _0:non-fusable ... + p:fsp-intf + ;; There can be zero transformers here: + t:fst-intf ... + c:fsc-intf + _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-intf ... + c:fsc-intf + _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-intf + ;; Must be 1 or more transformers here: + t:fst-intf ...+ + _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-intf ...+ + _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))))) diff --git a/qi-lib/flow/core/deforest-templates.rkt b/qi-lib/flow/core/deforest-templates.rkt new file mode 100644 index 000000000..9f9038bc2 --- /dev/null +++ b/qi-lib/flow/core/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-test/tests/compiler/rules/private/deforest-util.rkt b/qi-test/tests/compiler/rules/private/deforest-util.rkt index 7746150e7..4ab71c7de 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) "cad*r-cstream")) + (string-contains? (format "~a" exp) "list-ref-cstream")) From 56f880a3f2239b1e2ef10036bdc4c4e29205458f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 5 May 2024 14:42:57 +0200 Subject: [PATCH 007/108] Split compiler passes into separate modules. - preliminary splitting of the compiler into separate modules for separate passes - update tests to reflect new paths --- .../pass-0010-normalize.rkt} | 6 +- qi-lib/flow/core/passes/pass-1000-qi0.rkt | 423 ++++++++++++++++++ .../flow/core/passes/pass-2000-bindings.rkt | 70 +++ qi-test/tests/compiler/rules/deforest.rkt | 2 +- qi-test/tests/compiler/rules/full-cycle.rkt | 2 +- 5 files changed, 498 insertions(+), 5 deletions(-) rename qi-lib/flow/core/{normalize.rkt => passes/pass-0010-normalize.rkt} (95%) create mode 100644 qi-lib/flow/core/passes/pass-1000-qi0.rkt create mode 100644 qi-lib/flow/core/passes/pass-2000-bindings.rkt diff --git a/qi-lib/flow/core/normalize.rkt b/qi-lib/flow/core/passes/pass-0010-normalize.rkt similarity index 95% rename from qi-lib/flow/core/normalize.rkt rename to qi-lib/flow/core/passes/pass-0010-normalize.rkt index 387aac0a1..fce732c04 100644 --- a/qi-lib/flow/core/normalize.rkt +++ b/qi-lib/flow/core/passes/pass-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/passes/pass-1000-qi0.rkt b/qi-lib/flow/core/passes/pass-1000-qi0.rkt new file mode 100644 index 000000000..656b73586 --- /dev/null +++ b/qi-lib/flow/core/passes/pass-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/passes/pass-2000-bindings.rkt b/qi-lib/flow/core/passes/pass-2000-bindings.rkt new file mode 100644 index 000000000..bd15a4837 --- /dev/null +++ b/qi-lib/flow/core/passes/pass-2000-bindings.rkt @@ -0,0 +1,70 @@ +#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 ...) + (set! ids + (append (attribute x) ids))] + [_ 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-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index 5d2f06704..9e80ea73c 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -9,7 +9,7 @@ ;; necessary to correctly expand the right-threading form qi/flow/extended/forms qi/flow/core/compiler - qi/flow/core/deforest + qi/flow/core/passes/pass-0100-deforest 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 e7e174966..a80604e26 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/passes/pass-0100-deforest "private/deforest-util.rkt" (submod qi/flow/extended/expander invoke)) From 5813c77c13307b0b35b3ed3660fd226f0449ea0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 5 May 2024 14:47:59 +0200 Subject: [PATCH 008/108] Move deforestation infrastructure into passes subdirectory. --- .../core/{deforest-cps.rkt => passes/deforest/cps.rkt} | 6 +++--- .../deforest/syntax.rkt} | 10 +++++----- .../deforest/templates.rkt} | 0 .../{deforest.rkt => passes/pass-0100-deforest.rkt} | 0 qi-lib/list.rkt | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) rename qi-lib/flow/core/{deforest-cps.rkt => passes/deforest/cps.rkt} (98%) rename qi-lib/flow/core/{deforest-syntax.rkt => passes/deforest/syntax.rkt} (98%) rename qi-lib/flow/core/{deforest-templates.rkt => passes/deforest/templates.rkt} (100%) rename qi-lib/flow/core/{deforest.rkt => passes/pass-0100-deforest.rkt} (100%) diff --git a/qi-lib/flow/core/deforest-cps.rkt b/qi-lib/flow/core/passes/deforest/cps.rkt similarity index 98% rename from qi-lib/flow/core/deforest-cps.rkt rename to qi-lib/flow/core/passes/deforest/cps.rkt index c834aafa1..029df5dde 100644 --- a/qi-lib/flow/core/deforest-cps.rkt +++ b/qi-lib/flow/core/passes/deforest/cps.rkt @@ -4,11 +4,11 @@ (require (for-syntax racket/base syntax/parse - "deforest-syntax.rkt" - "../extended/util.rkt" + "syntax.rkt" + "../../../extended/util.rkt" syntax/srcloc racket/syntax-srcloc) - "deforest-templates.rkt" + "templates.rkt" racket/performance-hint racket/match racket/contract/base) diff --git a/qi-lib/flow/core/deforest-syntax.rkt b/qi-lib/flow/core/passes/deforest/syntax.rkt similarity index 98% rename from qi-lib/flow/core/deforest-syntax.rkt rename to qi-lib/flow/core/passes/deforest/syntax.rkt index 790a771b2..f83f53b08 100644 --- a/qi-lib/flow/core/deforest-syntax.rkt +++ b/qi-lib/flow/core/passes/deforest/syntax.rkt @@ -22,12 +22,12 @@ ) (require syntax/parse - "passes.rkt" - "strategy.rkt" + "../../passes.rkt" + "../../strategy.rkt" (for-template racket/base - "passes.rkt" - "strategy.rkt" - "deforest-templates.rkt") + "../../passes.rkt" + "../../strategy.rkt" + "templates.rkt") (for-syntax racket/base syntax/parse)) diff --git a/qi-lib/flow/core/deforest-templates.rkt b/qi-lib/flow/core/passes/deforest/templates.rkt similarity index 100% rename from qi-lib/flow/core/deforest-templates.rkt rename to qi-lib/flow/core/passes/deforest/templates.rkt diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/passes/pass-0100-deforest.rkt similarity index 100% rename from qi-lib/flow/core/deforest.rkt rename to qi-lib/flow/core/passes/pass-0100-deforest.rkt diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index dd3e56b3a..de2f14d4b 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -3,6 +3,6 @@ ;; Upon instantiation of the module it define-and-register-pass for ;; deforestation (require racket/list - "flow/core/deforest.rkt") + "flow/core/passes/pass-0100-deforest.rkt") (provide (all-from-out racket/list)) From 30d812e3f5389df80c153167baeffe8d53824b31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 5 May 2024 15:11:01 +0200 Subject: [PATCH 009/108] Finish fixing all the things broken by the rebase. --- qi-lib/flow/core/compiler.rkt | 497 +----------------- .../flow/core/passes/pass-0100-deforest.rkt | 492 +---------------- qi-lib/flow/core/passes/pass-1000-qi0.rkt | 5 +- .../flow/core/passes/pass-2000-bindings.rkt | 7 +- 4 files changed, 16 insertions(+), 985 deletions(-) diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index 0c98f91b2..81301116d 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -3,500 +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) + "passes/pass-1000-qi0.rkt" + "passes/pass-2000-bindings.rkt" + "passes/pass-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) - #'(λ args - (apply filter-values - (qi0->racket onex) - args))])) - - (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/passes/pass-0100-deforest.rkt b/qi-lib/flow/core/passes/pass-0100-deforest.rkt index 7ee980356..6ab99823e 100644 --- a/qi-lib/flow/core/passes/pass-0100-deforest.rkt +++ b/qi-lib/flow/core/passes/pass-0100-deforest.rkt @@ -1,495 +1,5 @@ #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))])])) - - (define-syntax-class cad*r-datum - #:attributes (countdown) - (pattern (~datum car) #:attr countdown #'0) - (pattern (~datum cadr) #:attr countdown #'1) - (pattern (~datum caddr) #:attr countdown #'2) - (pattern (~datum cadddr) #:attr countdown #'3) - (pattern (~datum caddddr) #:attr countdown #'4) - (pattern (~datum cadddddr) #:attr countdown #'5)) - - ;; 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 - #:datum-literals (#%host-expression #%blanket-template __ _ #%fine-template) - (pattern (~or (#%blanket-template - ((#%host-expression (~or (~datum filter) - (~datum filter-map))) - (#%host-expression f) - __)) - (#%fine-template - ((#%host-expression (~or (~datum filter) - (~datum filter-map))) - (#%host-expression f) - _))))) - - ;; 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) - - (pattern (~or (#%blanket-template - ((#%host-expression (~datum filter-map)) - (#%host-expression f) - __)) - (#%fine-template - ((#%host-expression (~datum filter-map)) - (#%host-expression f) - _))) - #:attr next #'filter-map-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 cad*r:cad*r-datum)) - (#%fine-template - ((#%host-expression cad*r:cad*r-datum) _)) - (#%blanket-template - ((#%host-expression cad*r:cad*r-datum) __))) - #:attr end #'(cad*r-cstream-next cad*r.countdown 'cad*r)) - - (pattern (~or (#%fine-template - ((#%host-expression (~datum list-ref)) _ idx)) - (#%blanket-template - ((#%host-expression (~datum list-ref)) __ idx))) - #:attr end #'(cad*r-cstream-next idx 'list-ref)) - - (pattern (~or (esc - (#%host-expression (~datum length))) - (#%fine-template - ((#%host-expression (~datum length)) _)) - (#%blanket-template - ((#%host-expression (~datum length)) __))) - #:attr end #'(length-cstream-next)) - - (pattern (~or (esc - (#%host-expression (~or (~datum empty?) - (~datum null?)))) - (#%fine-template - ((#%host-expression (~or (~datum empty?) - (~datum null?))) _)) - (#%blanket-template - ((#%host-expression (~or (~datum empty?) - (~datum null?))) __))) - #:attr end #'(empty?-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)))))) - - (define-inline (filter-map-cstream-next f next) - (λ (done skip yield) - (next done - skip - (λ (value state) - (let ([fv (f value)]) - (if fv - (yield fv 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 (cad*r-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)))) - - ) +(require "deforest/cps.rkt") diff --git a/qi-lib/flow/core/passes/pass-1000-qi0.rkt b/qi-lib/flow/core/passes/pass-1000-qi0.rkt index 656b73586..689f2a9d5 100644 --- a/qi-lib/flow/core/passes/pass-1000-qi0.rkt +++ b/qi-lib/flow/core/passes/pass-1000-qi0.rkt @@ -329,7 +329,10 @@ the DSL. [_:id #'filter-values] [(_ onex:clause) - #'(curry filter-values (qi0->racket onex))])) + #'(λ args + (apply filter-values + (qi0->racket onex) + args))])) (define (fold-left-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/core/passes/pass-2000-bindings.rkt b/qi-lib/flow/core/passes/pass-2000-bindings.rkt index bd15a4837..7c51a53b4 100644 --- a/qi-lib/flow/core/passes/pass-2000-bindings.rkt +++ b/qi-lib/flow/core/passes/pass-2000-bindings.rkt @@ -50,8 +50,11 @@ (let ([ids null]) (find-and-map/qi (syntax-parser [((~datum as) x ...) - (set! ids - (append (attribute x) ids))] + (begin + (set! ids + (append (attribute x) ids)) + ;; we don't need to traverse further + #f)] [_ this-syntax]) stx) ids)) From 8ade24567af642a78f2fcb3b4a5782a9dec0e18a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 24 May 2024 18:59:29 +0200 Subject: [PATCH 010/108] Improve directory and module naming - rename compiler "passes" subdirectory to "compiler" - strip the passes modules file name pass- prefix --- qi-lib/flow/core/compiler.rkt | 6 +++--- .../pass-0010-normalize.rkt => compiler/0010-normalize.rkt} | 0 .../pass-0100-deforest.rkt => compiler/0100-deforest.rkt} | 0 .../{passes/pass-1000-qi0.rkt => compiler/1000-qi0.rkt} | 0 .../pass-2000-bindings.rkt => compiler/2000-bindings.rkt} | 0 qi-lib/flow/core/{passes => compiler}/deforest/cps.rkt | 0 qi-lib/flow/core/{passes => compiler}/deforest/syntax.rkt | 0 .../flow/core/{passes => compiler}/deforest/templates.rkt | 0 qi-lib/list.rkt | 2 +- qi-test/tests/compiler/rules/deforest.rkt | 2 +- qi-test/tests/compiler/rules/full-cycle.rkt | 2 +- 11 files changed, 6 insertions(+), 6 deletions(-) rename qi-lib/flow/core/{passes/pass-0010-normalize.rkt => compiler/0010-normalize.rkt} (100%) rename qi-lib/flow/core/{passes/pass-0100-deforest.rkt => compiler/0100-deforest.rkt} (100%) rename qi-lib/flow/core/{passes/pass-1000-qi0.rkt => compiler/1000-qi0.rkt} (100%) rename qi-lib/flow/core/{passes/pass-2000-bindings.rkt => compiler/2000-bindings.rkt} (100%) rename qi-lib/flow/core/{passes => compiler}/deforest/cps.rkt (100%) rename qi-lib/flow/core/{passes => compiler}/deforest/syntax.rkt (100%) rename qi-lib/flow/core/{passes => compiler}/deforest/templates.rkt (100%) diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index 81301116d..27ab37998 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -4,9 +4,9 @@ (require (for-syntax racket/base syntax/parse) - "passes/pass-1000-qi0.rkt" - "passes/pass-2000-bindings.rkt" - "passes/pass-0010-normalize.rkt" + "compiler/1000-qi0.rkt" + "compiler/2000-bindings.rkt" + "compiler/0010-normalize.rkt" "passes.rkt") (begin-for-syntax diff --git a/qi-lib/flow/core/passes/pass-0010-normalize.rkt b/qi-lib/flow/core/compiler/0010-normalize.rkt similarity index 100% rename from qi-lib/flow/core/passes/pass-0010-normalize.rkt rename to qi-lib/flow/core/compiler/0010-normalize.rkt diff --git a/qi-lib/flow/core/passes/pass-0100-deforest.rkt b/qi-lib/flow/core/compiler/0100-deforest.rkt similarity index 100% rename from qi-lib/flow/core/passes/pass-0100-deforest.rkt rename to qi-lib/flow/core/compiler/0100-deforest.rkt diff --git a/qi-lib/flow/core/passes/pass-1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt similarity index 100% rename from qi-lib/flow/core/passes/pass-1000-qi0.rkt rename to qi-lib/flow/core/compiler/1000-qi0.rkt diff --git a/qi-lib/flow/core/passes/pass-2000-bindings.rkt b/qi-lib/flow/core/compiler/2000-bindings.rkt similarity index 100% rename from qi-lib/flow/core/passes/pass-2000-bindings.rkt rename to qi-lib/flow/core/compiler/2000-bindings.rkt diff --git a/qi-lib/flow/core/passes/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt similarity index 100% rename from qi-lib/flow/core/passes/deforest/cps.rkt rename to qi-lib/flow/core/compiler/deforest/cps.rkt diff --git a/qi-lib/flow/core/passes/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt similarity index 100% rename from qi-lib/flow/core/passes/deforest/syntax.rkt rename to qi-lib/flow/core/compiler/deforest/syntax.rkt diff --git a/qi-lib/flow/core/passes/deforest/templates.rkt b/qi-lib/flow/core/compiler/deforest/templates.rkt similarity index 100% rename from qi-lib/flow/core/passes/deforest/templates.rkt rename to qi-lib/flow/core/compiler/deforest/templates.rkt diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index de2f14d4b..3d0757888 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -3,6 +3,6 @@ ;; Upon instantiation of the module it define-and-register-pass for ;; deforestation (require racket/list - "flow/core/passes/pass-0100-deforest.rkt") + "flow/core/compiler/0100-deforest.rkt") (provide (all-from-out racket/list)) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index 9e80ea73c..b68f1090f 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -9,7 +9,7 @@ ;; necessary to correctly expand the right-threading form qi/flow/extended/forms qi/flow/core/compiler - qi/flow/core/passes/pass-0100-deforest + qi/flow/core/compiler/0100-deforest 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 a80604e26..fe10a931c 100644 --- a/qi-test/tests/compiler/rules/full-cycle.rkt +++ b/qi-test/tests/compiler/rules/full-cycle.rkt @@ -11,7 +11,7 @@ rackunit/text-ui syntax/macro-testing qi/flow/core/compiler - qi/flow/core/passes/pass-0100-deforest + qi/flow/core/compiler/0100-deforest "private/deforest-util.rkt" (submod qi/flow/extended/expander invoke)) From 04ca28912c12f0bcb0b58ce5b4c340167e6c8a85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 31 May 2024 22:39:34 +0200 Subject: [PATCH 011/108] Deforest take with boxes. --- qi-lib/flow/core/compiler/deforest/cps.rkt | 25 ++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt index 029df5dde..09ad07ea8 100644 --- a/qi-lib/flow/core/compiler/deforest/cps.rkt +++ b/qi-lib/flow/core/compiler/deforest/cps.rkt @@ -21,7 +21,7 @@ (define-syntax inline-compose1 (syntax-rules () [(_ f) f] - [(_ [op f] rest ...) (op f (inline-compose1 rest ...))])) + [(_ [op (f ...)] rest ...) (op f ... (inline-compose1 rest ...))])) (begin-for-syntax @@ -142,14 +142,17 @@ (define-syntax-class fst #:attributes (next f) (pattern filter:fst-filter - #:attr f #'filter.f + #:attr f #'(filter.f) #:attr next #'filter-cstream-next) (pattern map:fst-map - #:attr f #'map.f + #:attr f #'(map.f) #:attr next #'map-cstream-next) (pattern filter-map:fst-filter-map - #:attr f #'filter-map.f + #:attr f #'(filter-map.f) #:attr next #'filter-map-cstream-next) + (pattern take:fst-take + #:attr f #'((box take.n)) + #:attr next #'take-cstream-next) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -258,6 +261,20 @@ (yield fv state) (skip state))))))) + (define-inline (take-cstream-next bn next) + (λ (done skip yield) + (λ (state) + (define n (unbox bn)) + (if (zero? n) + (done) + ((next (λ () + (error 'take-cstream-next "not enough")) + skip + (λ (value state) + (set-box! bn (sub1 n)) + (yield value state))) + state))))) + ;; Consumers (define-inline (cstream-next->list next ctx src) From bcb311800e8ccdeae9f9a1f7493a4a3f79277f6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 31 May 2024 23:01:11 +0200 Subject: [PATCH 012/108] Implement proper state cons-ing for take. --- qi-lib/flow/core/compiler/deforest/cps.rkt | 68 ++++++++++++++-------- 1 file changed, 43 insertions(+), 25 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt index 09ad07ea8..6560ca5f9 100644 --- a/qi-lib/flow/core/compiler/deforest/cps.rkt +++ b/qi-lib/flow/core/compiler/deforest/cps.rkt @@ -23,6 +23,13 @@ [(_ f) f] [(_ [op (f ...)] rest ...) (op f ... (inline-compose1 rest ...))])) +(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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -140,19 +147,23 @@ ;; Transformers (define-syntax-class fst - #:attributes (next f) + #:attributes (next f state) (pattern filter:fst-filter #:attr f #'(filter.f) - #:attr next #'filter-cstream-next) + #:attr next #'filter-cstream-next + #:attr state #'()) (pattern map:fst-map #:attr f #'(map.f) - #:attr next #'map-cstream-next) + #: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 next #'filter-map-cstream-next + #:attr state #'()) (pattern take:fst-take - #:attr f #'((box take.n)) - #:attr next #'take-cstream-next) + #:attr f #'() + #:attr next #'take-cstream-next + #:attr state #'(take.n)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -190,6 +201,9 @@ (#,((attribute p.curry) ctx (attribute p.name)) (contract p.contract (p.prepare + (lambda (state) + (define cstate (inline-consing state t.state ...)) + cstate) (#,@#'c.end (inline-compose1 [t.next t.f] ... p.next) @@ -200,7 +214,9 @@ '#,(prettify-flow-syntax ctx) #f '#,(build-source-location-vector - (syntax-srcloc ctx)))))]))) + (syntax-srcloc ctx)))))])) + + ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Runtime @@ -214,9 +230,9 @@ (cond [(null? state) (done)] [else (yield (car state) (cdr state))]))) - (define-inline (list->cstream-prepare next) + (define-inline (list->cstream-prepare consing next) (case-lambda - [(lst) (next lst)] + [(lst) (next (consing lst))] [rest (void)])) (define-inline (range->cstream-next done skip yield) @@ -226,11 +242,11 @@ (yield l (cons (+ l s) (cdr state)))] [else (done)]))) - (define-inline (range->cstream-prepare next) + (define-inline (range->cstream-prepare consing next) (case-lambda - [(h) (next (list 0 h 1))] - [(l h) (next (list l h 1))] - [(l h s) (next (list l h s))] + [(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 @@ -261,19 +277,21 @@ (yield fv state) (skip state))))))) - (define-inline (take-cstream-next bn next) + (define-inline (take-cstream-next next) (λ (done skip yield) - (λ (state) - (define n (unbox bn)) - (if (zero? n) - (done) - ((next (λ () - (error 'take-cstream-next "not enough")) - skip - (λ (value state) - (set-box! bn (sub1 n)) - (yield value state))) - state))))) + (λ (take-state) + (define n (car take-state)) + (define state (cdr take-state)) + (cond ((zero? n) + (done)) + (else + ((next (λ () + (error 'take-cstream-next "not enough")) + skip + (λ (value state) + (define new-state (cons (sub1 n) state)) + (yield value new-state))) + state)))))) ;; Consumers From 301a54285f0927a4536b2b4ef02e509d0b8082c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 31 May 2024 23:23:40 +0200 Subject: [PATCH 013/108] Add source syntax context to transformer composition. --- qi-lib/flow/core/compiler/deforest/cps.rkt | 27 +++++++++++++++------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt index 6560ca5f9..406b77700 100644 --- a/qi-lib/flow/core/compiler/deforest/cps.rkt +++ b/qi-lib/flow/core/compiler/deforest/cps.rkt @@ -21,7 +21,8 @@ (define-syntax inline-compose1 (syntax-rules () [(_ f) f] - [(_ [op (f ...)] rest ...) (op f ... (inline-compose1 rest ...))])) + [(_ [op (f ...) g ...] rest ...) (op f ... (inline-compose1 rest ...) g ...)] + )) (define-syntax inline-consing (syntax-rules () @@ -205,8 +206,13 @@ (define cstate (inline-consing state t.state ...)) cstate) (#,@#'c.end - (inline-compose1 [t.next t.f] ... - p.next) + (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)))) @@ -251,14 +257,14 @@ ;; Transformers - (define-inline (map-cstream-next f next) + (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) + (define-inline (filter-cstream-next f next ctx src) (λ (done skip yield) (next done skip @@ -267,7 +273,7 @@ (yield value state) (skip state)))))) - (define-inline (filter-map-cstream-next f next) + (define-inline (filter-map-cstream-next f next ctx src) (λ (done skip yield) (next done skip @@ -277,7 +283,7 @@ (yield fv state) (skip state))))))) - (define-inline (take-cstream-next next) + (define-inline (take-cstream-next next ctx src) (λ (done skip yield) (λ (take-state) (define n (car take-state)) @@ -286,7 +292,12 @@ (done)) (else ((next (λ () - (error 'take-cstream-next "not enough")) + ((contract (-> pair? any) + (λ (v) v) + 'take ctx + #f + src + ) '())) skip (λ (value state) (define new-state (cons (sub1 n) state)) From a0381d77f24004d38e4b6199ed1553e63fda2ff8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 14 Jun 2024 09:58:40 +0200 Subject: [PATCH 014/108] New qi/list bindings and their literal matching, stateful transformers fixes and tests for them. --- qi-doc/scribblings/qi.scrbl | 1 + qi-lib/flow/core/compiler/deforest/cps.rkt | 46 +++++----- qi-lib/flow/core/compiler/deforest/syntax.rkt | 85 +++++++++---------- qi-lib/list.rkt | 6 +- qi-test/tests/compiler/semantics.rkt | 14 ++- 5 files changed, 83 insertions(+), 69 deletions(-) diff --git a/qi-doc/scribblings/qi.scrbl b/qi-doc/scribblings/qi.scrbl index dc7384f32..c76c7f85c 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/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt index 406b77700..918a684a6 100644 --- a/qi-lib/flow/core/compiler/deforest/cps.rkt +++ b/qi-lib/flow/core/compiler/deforest/cps.rkt @@ -198,29 +198,30 @@ ;; 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 - (lambda (state) - (define cstate (inline-consing state t.state ...)) - cstate) - (#,@#'c.end - (inline-compose1 [t.next t.f - '#,(prettify-flow-syntax ctx) - '#,(build-source-location-vector - (syntax-srcloc ctx)) - ] ... - p.next - ) + (with-syntax (((rt ...) (reverse (attribute t.state)))) + #`(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)))) - p.name - '#,(prettify-flow-syntax ctx) - #f - '#,(build-source-location-vector - (syntax-srcloc ctx)))))])) + (syntax-srcloc ctx))))))])) ) @@ -298,7 +299,8 @@ #f src ) '())) - skip + (λ (state) + (skip (cons n state))) (λ (value state) (define new-state (cons (sub1 n) state)) (yield value new-state))) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index f83f53b08..53527a320 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -27,7 +27,8 @@ (for-template racket/base "../../passes.rkt" "../../strategy.rkt" - "templates.rkt") + "templates.rkt" + (prefix-in qi: "bindings.rkt")) (for-syntax racket/base syntax/parse)) @@ -41,15 +42,15 @@ (define-syntax-class fsp-range #:attributes (blanket? fine? arg pre-arg post-arg) #:literal-sets (fs-literals) - #:datum-literals (range) - (pattern (esc (#%host-expression range)) + #: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 range) + ((#%host-expression qi:range) the-arg ...)) #:attr arg #'(the-arg ...) #:attr pre-arg #f @@ -57,7 +58,7 @@ #:attr blanket? #f #:attr fine? #t) (pattern (#%blanket-template - ((#%host-expression range) + ((#%host-expression qi:range) (#%host-expression the-pre-arg) ... __ (#%host-expression the-post-arg) ...)) @@ -83,52 +84,52 @@ (define-syntax-class fst-filter #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (filter) + #:literals (qi:filter) (pattern (#%blanket-template - ((#%host-expression filter) + ((#%host-expression qi:filter) (#%host-expression f) __))) (pattern (#%fine-template - ((#%host-expression filter) + ((#%host-expression qi:filter) (#%host-expression f) _)))) (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (map) + #:literals (qi:map) (pattern (#%blanket-template - ((#%host-expression map) + ((#%host-expression qi:map) (#%host-expression f) __))) (pattern (#%fine-template - ((#%host-expression map) + ((#%host-expression qi:map) (#%host-expression f) _)))) (define-syntax-class fst-filter-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (filter-map) + #:literals (qi:filter-map) (pattern (#%blanket-template - ((#%host-expression filter-map) + ((#%host-expression qi:filter-map) (#%host-expression f) __))) (pattern (#%fine-template - ((#%host-expression filter-map) + ((#%host-expression qi:filter-map) (#%host-expression f) _)))) (define-syntax-class fst-take #:attributes (n) #:literal-sets (fs-literals) - #:datum-literals (take) + #:literals (qi:take) (pattern (#%blanket-template - ((#%host-expression take) + ((#%host-expression qi:take) __ (#%host-expression n)))) (pattern (#%fine-template - ((#%host-expression take) + ((#%host-expression qi:take) _ (#%host-expression n))))) @@ -148,14 +149,14 @@ (define-syntax-class fsc-foldr #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (foldr) + #:literals (qi:foldr) (pattern (#%blanket-template - ((#%host-expression foldr) + ((#%host-expression qi:foldr) (#%host-expression op) (#%host-expression init) __))) (pattern (#%fine-template - ((#%host-expression foldr) + ((#%host-expression qi:foldr) (#%host-expression op) (#%host-expression init) _)))) @@ -163,35 +164,33 @@ (define-syntax-class fsc-foldl #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (foldl) + #:literals (qi:foldl) (pattern (#%blanket-template - ((#%host-expression foldl) + ((#%host-expression qi:foldl) (#%host-expression op) (#%host-expression init) __))) (pattern (#%fine-template - ((#%host-expression foldl) + ((#%host-expression qi:foldl) (#%host-expression op) (#%host-expression init) _)))) (define-syntax-class cad*r-datum #:attributes (countdown) - (pattern (~datum car) #:attr countdown #'0) - (pattern (~datum cadr) #:attr countdown #'1) - (pattern (~datum caddr) #:attr countdown #'2) - (pattern (~datum cadddr) #:attr countdown #'3) - (pattern (~datum caddddr) #:attr countdown #'4) - (pattern (~datum cadddddr) #:attr countdown #'5)) + (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) - #:datum-literals (list-ref) + #:literals (qi:list-ref) (pattern (~or (#%fine-template - ((#%host-expression list-ref) _ idx)) + ((#%host-expression qi:list-ref) _ idx)) (#%blanket-template - ((#%host-expression list-ref) __ idx))) + ((#%host-expression qi:list-ref) __ idx))) #:attr pos #'idx #:attr name #'list-ref) (pattern (~or (esc (#%host-expression cad*r:cad*r-datum)) @@ -204,26 +203,26 @@ (define-syntax-class fsc-length #:literal-sets (fs-literals) - #:datum-literals (length) + #:literals (qi:length) (pattern (esc - (#%host-expression length))) + (#%host-expression qi:length))) (pattern (#%fine-template - ((#%host-expression length) _))) + ((#%host-expression qi:length) _))) (pattern (#%blanket-template - ((#%host-expression length) __)))) + ((#%host-expression qi:length) __)))) (define-syntax-class fsc-empty? #:literal-sets (fs-literals) - #:datum-literals (empty? null?) + #:literals (qi:null? qi:empty?) (pattern (esc - (#%host-expression (~or empty? - null?)))) + (#%host-expression (~or qi:empty? + qi:null?)))) (pattern (#%fine-template - ((#%host-expression (~or empty? - null?)) _))) + ((#%host-expression (~or qi:empty? + qi:null?)) _))) (pattern (#%blanket-template - ((#%host-expression (~or empty? - null?)) __)))) + ((#%host-expression (~or qi:empty? + qi:null?)) __)))) (define-syntax-class fsc-default #:datum-literals (cstream->list) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 3d0757888..2558d68ae 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/compiler/0100-deforest.rkt") +(require "flow/core/compiler/0100-deforest.rkt" + "flow/core/compiler/deforest/binding.rkt") -(provide (all-from-out racket/list)) +(provide (all-from-out "flow/core/compiler/deforest/binding.rkt")) diff --git a/qi-test/tests/compiler/semantics.rkt b/qi-test/tests/compiler/semantics.rkt index 2ffcad815..5453f38b4 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))) From 6fd8a932762943f3ec5837f4a8f4550de5dbb66d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 15 Jun 2024 10:53:26 +0200 Subject: [PATCH 015/108] Deforestation: rename all fusable stream syntax classes to fs[PTC]-syntax and do not provide them. --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 33 +++++++++---------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 53527a320..dfab0e9cc 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -1,16 +1,13 @@ #lang racket/base -(provide fsp-intf - fsp-range +(provide fsp-range fsp-default - fst-intf fst-filter fst-map fst-filter-map fst-take - fsc-intf fsc-foldr fsc-foldl fsc-list-ref @@ -74,7 +71,7 @@ #:attr contract #'(-> list? any) #:attr name #''list->cstream)) -(define-syntax-class fsp-intf +(define-syntax-class fsp-syntax (pattern (~or _:fsp-range _:fsp-default))) @@ -137,7 +134,7 @@ (pattern (~or filter:fst-filter filter-map:fst-filter-map))) -(define-syntax-class fst-intf +(define-syntax-class fst-syntax (pattern (~or _:fst-filter _:fst-map _:fst-filter-map @@ -228,7 +225,7 @@ #:datum-literals (cstream->list) (pattern cstream->list)) -(define-syntax-class fsc-intf +(define-syntax-class fsc-syntax (pattern (~or _:fsc-foldr _:fsc-foldl _:fsc-list-ref @@ -243,18 +240,18 @@ ;; Used only in deforest-rewrite to properly recognize the end of ;; fusable sequence. (define-syntax-class non-fusable - (pattern (~not (~or _:fst-intf - _:fsp-intf - _:fsc-intf)))) + (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-intf + p:fsp-syntax ;; There can be zero transformers here: - t:fst-intf ... - c:fsc-intf + t:fst-syntax ... + c:fsc-syntax _1 ...) #:with fused (generate-fused-operation (syntax->list #'(p t ... c)) @@ -262,17 +259,17 @@ #'(thread _0 ... fused _1 ...)] [((~datum thread) _0:non-fusable ... t1:fst-intf0 - t:fst-intf ... - c:fsc-intf + 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-intf + p:fsp-syntax ;; Must be 1 or more transformers here: - t:fst-intf ...+ + t:fst-syntax ...+ _1 ...) #:with fused (generate-fused-operation (syntax->list #'(p t ... cstream->list)) @@ -280,7 +277,7 @@ #'(thread _0 ... fused _1 ...)] [((~datum thread) _0:non-fusable ... f1:fst-intf0 - f:fst-intf ...+ + f:fst-syntax ...+ _1 ...) #:with fused (generate-fused-operation (syntax->list #'(list->cstream f1 f ... cstream->list)) From 1975925a3c1b2feee4354dcfa7e77825ff6f31d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 15 Jun 2024 11:14:22 +0200 Subject: [PATCH 016/108] Fix tests of qi/list - use the new bindings. --- qi-test/tests/compiler/rules/deforest.rkt | 1 + qi-test/tests/compiler/rules/full-cycle.rkt | 1 + 2 files changed, 2 insertions(+) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index b68f1090f..1023475d6 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -10,6 +10,7 @@ qi/flow/extended/forms qi/flow/core/compiler 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 fe10a931c..314d5c847 100644 --- a/qi-test/tests/compiler/rules/full-cycle.rkt +++ b/qi-test/tests/compiler/rules/full-cycle.rkt @@ -12,6 +12,7 @@ syntax/macro-testing qi/flow/core/compiler qi/flow/core/compiler/0100-deforest + qi/list "private/deforest-util.rkt" (submod qi/flow/extended/expander invoke)) From 0134706f6a5422edd1a5408ad08ea7df81a328c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 14 Jun 2024 10:57:34 +0200 Subject: [PATCH 017/108] Split bindings module and add appropriate scribblings. - scribblings for qi/list module - scribble the new literals for matching in deforestation pass - ensure for-label bindings in the generated documentation - new bindings.rkt module --- qi-doc/scribblings/list-operations.scrbl | 118 ++++++++++++++++++ .../flow/core/compiler/deforest/bindings.rkt | 35 ++++++ qi-lib/list.rkt | 4 +- 3 files changed, 155 insertions(+), 2 deletions(-) create mode 100644 qi-doc/scribblings/list-operations.scrbl create mode 100644 qi-lib/flow/core/compiler/deforest/bindings.rkt diff --git a/qi-doc/scribblings/list-operations.scrbl b/qi-doc/scribblings/list-operations.scrbl new file mode 100644 index 000000000..2b70c1181 --- /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-lib/flow/core/compiler/deforest/bindings.rkt b/qi-lib/flow/core/compiler/deforest/bindings.rkt new file mode 100644 index 000000000..22eccb9a7 --- /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/list.rkt b/qi-lib/list.rkt index 2558d68ae..0e8ca781f 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -3,6 +3,6 @@ ;; Upon instantiation of the module it define-and-register-pass for ;; deforestation (require "flow/core/compiler/0100-deforest.rkt" - "flow/core/compiler/deforest/binding.rkt") + "flow/core/compiler/deforest/bindings.rkt") -(provide (all-from-out "flow/core/compiler/deforest/binding.rkt")) +(provide (all-from-out "flow/core/compiler/deforest/bindings.rkt")) From 3288d0e4402d078097defc455daacf78c9f0167e 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 018/108] 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))))) From 536c75de50c949bcc196571bd4e1a35d29801d90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 28 Jun 2024 19:45:26 +0200 Subject: [PATCH 019/108] Fix phase shifting for fusion.rkt module. --- qi-lib/flow/core/compiler/deforest/fusion.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/qi-lib/flow/core/compiler/deforest/fusion.rkt b/qi-lib/flow/core/compiler/deforest/fusion.rkt index 9049c377a..6f2ccf43d 100644 --- a/qi-lib/flow/core/compiler/deforest/fusion.rkt +++ b/qi-lib/flow/core/compiler/deforest/fusion.rkt @@ -7,7 +7,9 @@ syntax/parse "syntax.rkt" "../../passes.rkt" - "../../strategy.rkt") + "../../strategy.rkt" + (for-template "../../passes.rkt")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The actual fusion generator implementation From ff5a39524c115d3e1bf1783d63f7fd393b3cee6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 28 Jun 2024 19:52:14 +0200 Subject: [PATCH 020/108] Add attach-form-property to both places needed by current deforestation (CPS) implementation. --- qi-lib/flow/core/compiler/deforest/cps.rkt | 50 +++++------ qi-lib/flow/core/compiler/deforest/fusion.rkt | 84 ++++++++++--------- 2 files changed, 69 insertions(+), 65 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt index 65072bcd7..59ccc7d94 100644 --- a/qi-lib/flow/core/compiler/deforest/cps.rkt +++ b/qi-lib/flow/core/compiler/deforest/cps.rkt @@ -8,7 +8,8 @@ "../../../extended/util.rkt" syntax/srcloc racket/syntax-srcloc - "fusion.rkt") + "fusion.rkt" + "../../private/form-property.rkt") "templates.rkt" racket/performance-hint racket/match @@ -207,29 +208,30 @@ ;; fused sequence. And runtime checks for consumers are in ;; their respective implementation procedure. (with-syntax (((rt ...) (reverse (attribute t.state)))) - #`(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))))))])) + (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)))))))])) ) diff --git a/qi-lib/flow/core/compiler/deforest/fusion.rkt b/qi-lib/flow/core/compiler/deforest/fusion.rkt index 6f2ccf43d..46448995c 100644 --- a/qi-lib/flow/core/compiler/deforest/fusion.rkt +++ b/qi-lib/flow/core/compiler/deforest/fusion.rkt @@ -8,7 +8,8 @@ "syntax.rkt" "../../passes.rkt" "../../strategy.rkt" - (for-template "../../passes.rkt")) + (for-template "../../passes.rkt") + "../../private/form-property.rkt") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The actual fusion generator implementation @@ -22,46 +23,47 @@ (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]))) + (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 From 97a845da24ed7410ca6d69212c873a56c36622aa Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 2 Aug 2024 17:23:13 -0700 Subject: [PATCH 021/108] Remove unused `require` --- qi-test/tests/compiler/rules/full-cycle.rkt | 1 - 1 file changed, 1 deletion(-) diff --git a/qi-test/tests/compiler/rules/full-cycle.rkt b/qi-test/tests/compiler/rules/full-cycle.rkt index 314d5c847..d225d482d 100644 --- a/qi-test/tests/compiler/rules/full-cycle.rkt +++ b/qi-test/tests/compiler/rules/full-cycle.rkt @@ -11,7 +11,6 @@ rackunit/text-ui syntax/macro-testing qi/flow/core/compiler - qi/flow/core/compiler/0100-deforest qi/list "private/deforest-util.rkt" (submod qi/flow/extended/expander invoke)) From 510acb943d69323668124bc5703f5d290c9a5587 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 28 Jun 2024 20:38:29 -0700 Subject: [PATCH 022/108] Introduce a `#%deforestable` core form This form is intended to express any deforestable expression, allowing the core language to express deforestation semantics, which, formerly, we were not able to do within the language and thus resorted to matching, and optimizing, host language syntax, leading to a "host" of problems. This new form is groundwork to enable compiler optimizations being defined purely on the core language, thus representing a clean boundary, or contract, between Qi and the host (Racket). The initial implementation here just introduces the form, and code generation for `filter` specifically, as a proof of concept for the more generic and extensible planned implementation. See the meeting notes for more, e.g.: https://github.com/drym-org/qi/wiki/Qi-Meeting-Jun-21-2024#implementing-it --- qi-lib/flow/core/compiler/1000-qi0.rkt | 10 +++++++--- qi-lib/flow/core/syntax.rkt | 18 +++++++++++++----- qi-lib/flow/extended/expander.rkt | 3 +++ 3 files changed, 23 insertions(+), 8 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 689f2a9d5..31df8b409 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -96,6 +96,7 @@ [(~datum appleye) #'call] [e:clos-form (clos-parser #'e)] + [e:deforestable-form (deforestable-parser #'e)] ;; escape hatch for racket expressions or anything ;; to be "passed through" [((~datum esc) ex:expr) @@ -105,9 +106,6 @@ ;; 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)] @@ -396,6 +394,12 @@ the DSL. (qi0->racket (~> (-< (~> (gen args) △) _) onex))))])) + (define (deforestable-parser stx) + (syntax-parse stx + [((~datum #%deforestable) (~datum filter) (proc:clause) (arg:expr ...)) + #'(lambda (v) + (filter (qi0->racket proc) v))])) + (define (blanket-template-form-parser stx) (syntax-parse stx ;; "prarg" = "pre-supplied argument" diff --git a/qi-lib/flow/core/syntax.rkt b/qi-lib/flow/core/syntax.rkt index 2cf8a0ca8..e70ff09e3 100644 --- a/qi-lib/flow/core/syntax.rkt +++ b/qi-lib/flow/core/syntax.rkt @@ -17,7 +17,8 @@ fold-left-form fold-right-form loop-form - clos-form) + clos-form + deforestable-form) (require syntax/parse) @@ -26,10 +27,13 @@ These syntax classes are used in the flow macro to handle matching of the input syntax to valid Qi syntax. Typically, _matching_ is the only function these syntax classes fulfill, and once matched, the input syntax is typically handed over to dedicated parsers that -independently parse and expand the input. It's done this way to keep -the clauses of the flow macro specific to individual forms, instead of -these forms appearing in multiple clauses, so that the code for each -form is decoupled from the rest of the flow macro. +independently parse and expand the input. It's done this way for two +reasons. First, the syntax has already been parsed/validated by the +expander and we don't need to worry about validation at the compiler +level. And second, to keep the clauses of the Qi0→Racket codegen macro +specific to individual forms, instead of these forms appearing in +multiple clauses, so that the code for each form is neatly decoupled +from code generation for other forms. See comments in flow.rkt for more details. |# @@ -131,3 +135,7 @@ See comments in flow.rkt for more details. (~datum clos)) (pattern ((~datum clos) arg ...))) + +(define-syntax-class deforestable-form + (pattern + ((~datum #%deforestable) arg ...))) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index 8a2a3782c..bf4da23b1 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -183,6 +183,9 @@ core language's use of #%app, etc.). (clos onex:closed-floe) (esc ex:racket-expr) + ;; core form to express deforestable operations + (#%deforestable name:id (proc:closed-floe) (arg:racket-expr ...)) + ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) #'(esc (ext-form expr ...))) From 0bed239980190ce3c3ca4bb5cd672e2add687d47 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sat, 29 Jun 2024 09:32:41 -0700 Subject: [PATCH 023/108] support basic cases of filter, map, foldl, foldr and range --- qi-lib/flow/core/compiler/1000-qi0.rkt | 18 ++++++++++++++++-- qi-lib/flow/extended/expander.rkt | 2 +- qi-test/tests/flow.rkt | 7 +++++++ 3 files changed, 24 insertions(+), 3 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 31df8b409..d2e503520 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -4,7 +4,9 @@ (prefix-in fancy: fancy-app) "../impl.rkt" racket/function - (only-in racket/list make-list) + (only-in racket/list + make-list + range) (for-syntax racket/base syntax/parse "../syntax.rkt" @@ -398,7 +400,19 @@ the DSL. (syntax-parse stx [((~datum #%deforestable) (~datum filter) (proc:clause) (arg:expr ...)) #'(lambda (v) - (filter (qi0->racket proc) v))])) + (filter (qi0->racket proc) v))] + [((~datum #%deforestable) (~datum map) (proc:clause) (arg:expr ...)) + #'(lambda (v) + (map (qi0->racket proc) v))] + [((~datum #%deforestable) (~datum foldl) (proc:clause) (init:expr)) + #'(lambda (v) + (foldl (qi0->racket proc) init v))] + [((~datum #%deforestable) (~datum foldr) (proc:clause) (init:expr)) + #'(lambda (v) + (foldr (qi0->racket proc) init v))] + [((~datum #%deforestable) (~datum range) () (arg:expr ...)) + #'(lambda () + (range arg ...))])) (define (blanket-template-form-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index bf4da23b1..33a898a7a 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -184,7 +184,7 @@ core language's use of #%app, etc.). (esc ex:racket-expr) ;; core form to express deforestable operations - (#%deforestable name:id (proc:closed-floe) (arg:racket-expr ...)) + (#%deforestable name:id (proc:closed-floe ...) (arg:racket-expr ...)) ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index f7e765380..27ee100d5 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -285,6 +285,13 @@ (check-equal? ((☯ (esc (first (list + *)))) 3 7) 10 "normal racket expressions")) + (test-suite + "#%deforestable" + (check-equal? ((☯ (#%deforestable filter (odd?) ())) (list 1 2 3)) (list 1 3)) + (check-equal? ((☯ (#%deforestable map (sqr) ())) (list 1 2 3)) (list 1 4 9)) + (check-equal? ((☯ (#%deforestable foldl (+) (0))) (list 1 2 3)) 6) + (check-equal? ((☯ (#%deforestable foldr (+) (0))) (list 1 2 3)) 6) + (check-equal? ((☯ (#%deforestable range () (0 3)))) (list 0 1 2))) (test-suite "elementary boolean gates" (test-suite From c213e807a26b7b3561b7b432d6ad546681f7b0c6 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 1 Jul 2024 17:36:26 -0700 Subject: [PATCH 024/108] a couple more tests for `range` --- qi-test/tests/flow.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index 27ee100d5..e13a38181 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -291,7 +291,9 @@ (check-equal? ((☯ (#%deforestable map (sqr) ())) (list 1 2 3)) (list 1 4 9)) (check-equal? ((☯ (#%deforestable foldl (+) (0))) (list 1 2 3)) 6) (check-equal? ((☯ (#%deforestable foldr (+) (0))) (list 1 2 3)) 6) - (check-equal? ((☯ (#%deforestable range () (0 3)))) (list 0 1 2))) + (check-equal? ((☯ (#%deforestable range () (3)))) (list 0 1 2)) + (check-equal? ((☯ (#%deforestable range () (0 3)))) (list 0 1 2)) + (check-equal? ((☯ (#%deforestable range () (0 5 2)))) (list 0 2 4))) (test-suite "elementary boolean gates" (test-suite From c18556417c82451a6df8975bd5064f8261368da8 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Tue, 9 Jul 2024 20:29:01 -0700 Subject: [PATCH 025/108] formatting.. --- qi-lib/flow/extended/expander.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index 33a898a7a..f43aca889 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -184,7 +184,9 @@ core language's use of #%app, etc.). (esc ex:racket-expr) ;; core form to express deforestable operations - (#%deforestable name:id (proc:closed-floe ...) (arg:racket-expr ...)) + (#%deforestable name:id + (proc:closed-floe ...) + (arg:racket-expr ...)) ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) From cc8cf45382a9bf5c2b7af768b13a48d1dc58ada3 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 17:26:16 -0700 Subject: [PATCH 026/108] temporarily comment out some tests --- qi-test/tests/compiler/rules/deforest.rkt | 143 +++++++-------- qi-test/tests/compiler/semantics.rkt | 208 +++++++++++----------- 2 files changed, 177 insertions(+), 174 deletions(-) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index 1023475d6..3d832e183 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -67,71 +67,73 @@ ;; between the optimization being applied once vs twice. We would like it ;; to do so in order to validate and justify the need for fixed-point ;; finding in the deforestation pass. - (test-deforested "multiple applications of deforestation to the same expression" - #'(~>> (filter odd?) - (map sqr) - (foldr + 0) - range - (filter odd?) - (map sqr)))) + ;; (test-deforested "multiple applications of deforestation to the same expression" + ;; #'(~>> (filter odd?) + ;; (map sqr) + ;; (foldr + 0) + ;; range + ;; (filter odd?) + ;; (map sqr))) + ) (test-suite "transformers" (test-deforested "filter-map (two transformers)" #'(~>> (filter odd?) (map sqr))) - (test-deforested "fine-grained template forms" - #'(~>> (filter odd? _) (map sqr _)))) + ;; (test-deforested "fine-grained template forms" + ;; #'(~>> (filter odd? _) (map sqr _))) + ) - (test-suite - "producers" - ;; TODO: note that these uses of `range` are matched as datums - ;; and requiring racket/list's range is not required in this module - ;; for deforestation to happen. This should be changed to use - ;; literal matching in the compiler. - (test-deforested "range" - #'(~>> range (filter odd?))) - (test-deforested "(range _)" - #'(~>> (range _) (filter odd?))) - (test-deforested "(range _ _)" - #'(~>> (range _ _) (filter odd?))) - (test-deforested "(range 0 _)" - #'(~>> (range 0 _) (filter odd?))) - (test-deforested "(range _ 10)" - #'(~>> (range _ 10) (filter odd?))) - (test-deforested "(range _ _ _)" - #'(~>> (range _ _ _) (filter odd?))) - (test-deforested "(range _ _ 1)" - #'(~>> (range _ _ 1) (filter odd?))) - (test-deforested "(range _ 10 _)" - #'(~>> (range _ 10 _) (filter odd?))) - (test-deforested "(range _ 10 1)" - #'(~>> (range _ 10 1) (filter odd?))) - (test-deforested "(range 0 _ _)" - #'(~>> (range 0 _ _) (filter odd?))) - (test-deforested "(range 0 _ 1)" - #'(~>> (range 0 _ 1) (filter odd?))) - (test-deforested "(range 0 10 _)" - #'(~>> (range 0 10 _) (filter odd? __))) - (test-deforested "(range __)" - #'(~>> (range __) (filter odd?))) - (test-deforested "(range 0 __)" - #'(~>> (range 0 __) (filter odd?))) - (test-deforested "(range __ 1)" - #'(~>> (range __ 1) (filter odd?))) - (test-deforested "(range 0 10 __)" - #'(~>> (range 0 10 __) (filter odd?))) - (test-deforested "(range __ 10 1)" - #'(~>> (range __ 10 1) (filter odd? __))) - (test-deforested "(range 0 __ 1)" - #'(~>> (range 0 __ 1) (filter odd?))) - (test-deforested "(range 0 10 1 __)" - #'(~>> (range 0 10 1 __) (filter odd?))) - (test-deforested "(range 0 10 __ 1)" - #'(~>> (range 0 10 __ 1) (filter odd?))) - (test-deforested "(range 0 __ 10 1)" - #'(~>> (range 0 __ 10 1) (filter odd?))) - (test-deforested "(range __ 0 10 1)" - #'(~>> (range __ 0 10 1) (filter odd?)))) + ;; (test-suite + ;; "producers" + ;; ;; TODO: note that these uses of `range` are matched as datums + ;; ;; and requiring racket/list's range is not required in this module + ;; ;; for deforestation to happen. This should be changed to use + ;; ;; literal matching in the compiler. + ;; (test-deforested "range" + ;; #'(~>> range (filter odd?))) + ;; (test-deforested "(range _)" + ;; #'(~>> (range _) (filter odd?))) + ;; (test-deforested "(range _ _)" + ;; #'(~>> (range _ _) (filter odd?))) + ;; (test-deforested "(range 0 _)" + ;; #'(~>> (range 0 _) (filter odd?))) + ;; (test-deforested "(range _ 10)" + ;; #'(~>> (range _ 10) (filter odd?))) + ;; (test-deforested "(range _ _ _)" + ;; #'(~>> (range _ _ _) (filter odd?))) + ;; (test-deforested "(range _ _ 1)" + ;; #'(~>> (range _ _ 1) (filter odd?))) + ;; (test-deforested "(range _ 10 _)" + ;; #'(~>> (range _ 10 _) (filter odd?))) + ;; (test-deforested "(range _ 10 1)" + ;; #'(~>> (range _ 10 1) (filter odd?))) + ;; (test-deforested "(range 0 _ _)" + ;; #'(~>> (range 0 _ _) (filter odd?))) + ;; (test-deforested "(range 0 _ 1)" + ;; #'(~>> (range 0 _ 1) (filter odd?))) + ;; (test-deforested "(range 0 10 _)" + ;; #'(~>> (range 0 10 _) (filter odd? __))) + ;; (test-deforested "(range __)" + ;; #'(~>> (range __) (filter odd?))) + ;; (test-deforested "(range 0 __)" + ;; #'(~>> (range 0 __) (filter odd?))) + ;; (test-deforested "(range __ 1)" + ;; #'(~>> (range __ 1) (filter odd?))) + ;; (test-deforested "(range 0 10 __)" + ;; #'(~>> (range 0 10 __) (filter odd?))) + ;; (test-deforested "(range __ 10 1)" + ;; #'(~>> (range __ 10 1) (filter odd? __))) + ;; (test-deforested "(range 0 __ 1)" + ;; #'(~>> (range 0 __ 1) (filter odd?))) + ;; (test-deforested "(range 0 10 1 __)" + ;; #'(~>> (range 0 10 1 __) (filter odd?))) + ;; (test-deforested "(range 0 10 __ 1)" + ;; #'(~>> (range 0 10 __ 1) (filter odd?))) + ;; (test-deforested "(range 0 __ 10 1)" + ;; #'(~>> (range 0 __ 10 1) (filter odd?))) + ;; (test-deforested "(range __ 0 10 1)" + ;; #'(~>> (range __ 0 10 1) (filter odd?)))) (test-suite "consumers" @@ -149,17 +151,18 @@ (deforest-pass (expand-flow #'(>< (~>> (filter odd?) (map sqr)))))))) - (let ([stx (phase1-eval - (deforest-pass - (expand-flow - #'(-< (~>> (filter odd?) (map sqr)) - (~>> range car)))))]) - (test-true "multiple independent positions" - (deforested? stx)) - (test-true "multiple independent positions" - (filter-deforested? stx)) - (test-true "multiple independent positions" - (car-deforested? stx)))))) + ;; (let ([stx (phase1-eval + ;; (deforest-pass + ;; (expand-flow + ;; #'(-< (~>> (filter odd?) (map sqr)) + ;; (~>> range car)))))]) + ;; (test-true "multiple independent positions" + ;; (deforested? stx)) + ;; (test-true "multiple independent positions" + ;; (filter-deforested? stx)) + ;; (test-true "multiple independent positions" + ;; (car-deforested? stx))) + ))) (module+ main (void diff --git a/qi-test/tests/compiler/semantics.rkt b/qi-test/tests/compiler/semantics.rkt index 5453f38b4..aafb82de0 100644 --- a/qi-test/tests/compiler/semantics.rkt +++ b/qi-test/tests/compiler/semantics.rkt @@ -75,124 +75,124 @@ '(0 1 2 3 4 5 6 7 8 9)) '(1 9 25 49 81)) - (test-exn "deforestation range->cstream-next - too few arguments at runtime" - exn? - (lambda () - ((flow (~>> range (filter odd?) (map sqr)))))) + ;; (test-exn "deforestation range->cstream-next - too few arguments at runtime" + ;; exn? + ;; (lambda () + ;; ((flow (~>> range (filter odd?) (map sqr)))))) - (test-exn "deforestation range->cstream-next - too many arguments at runtime" - exn? - (lambda () - ((flow (~>> range (filter odd?) (map sqr))) 1 2 3 4))) + ;; (test-exn "deforestation range->cstream-next - too many arguments at runtime" + ;; exn? + ;; (lambda () + ;; ((flow (~>> range (filter odd?) (map sqr))) 1 2 3 4))) (test-exn "deforestation car-cstream-next - empty list" exn? (lambda () ((flow (~>> (filter odd?) (map sqr) car)) '())))) - (test-suite - "range (stream producer)" - ;; Semantic tests of the range producer that cover all combinations: - (test-equal? "~>>range [1-3] (10)" - (~>> (10) range (filter odd?) (map sqr)) - '(1 9 25 49 81)) - (test-equal? "~>range [1-3] (10)" - (~> (10) range (~>> (filter odd?) (map sqr))) - '(1 9 25 49 81)) - (test-equal? "~>> range [1-3] (5 10)" - (~>> (5 10) range (filter odd?) (map sqr)) - '(25 49 81)) - (test-equal? "~> range [1-3] (5 10)" - (~> (5 10) range (~>> (filter odd?) (map sqr))) - '(25 49 81)) - (test-equal? "~>> range [1-3] (5 10 3)" - (~>> (5 10 3) range (filter odd?) (map sqr)) - '(25)) - (test-equal? "~> range [1-3] (5 10 3)" - (~> (5 10 3) range (~>> (filter odd?) (map sqr))) - '(25)) - - (test-equal? "~>> (range 10) [0-2] ()" - (~>> () (range 10) (filter odd?) (map sqr)) - '(1 9 25 49 81)) - (test-equal? "~> (range 10) [0-2] ()" - (~> () (range 10) (~>> (filter odd?) (map sqr))) - '(1 9 25 49 81)) - (test-equal? "~>> (range 5) [0-2] (10)" - (~>> (10) (range 5) (filter odd?) (map sqr)) - '(25 49 81)) - (test-equal? "~> (range 10) [0-2] (5)" - (~> (5) (range 10) (~>> (filter odd?) (map sqr))) - '(25 49 81)) - (test-equal? "~>> (range 3) [0-2] (5 10)" - (~>> (3) (range 5 10) (filter odd?) (map sqr)) - '(25)) - (test-equal? "~> (range 5) [0-2] (10 3)" - (~> (5) (range 10 3) (~>> (filter odd?) (map sqr))) - '(25)) - - (test-equal? "~>> (range 5 10) [0-1] ()" - (~>> () (range 5 10) (filter odd?) (map sqr)) - '(25 49 81)) - (test-equal? "~> (range 5 10) [0-1] ()" - (~> () (range 5 10) (~>> (filter odd?) (map sqr))) - '(25 49 81)) - (test-equal? "~>> (range 5 10) [0-1] (3)" - (~>> (3) (range 5 10) (filter odd?) (map sqr)) - '(25)) - (test-equal? "~> (range 10 3) [0-1] (5)" - (~> (5) (range 10 3) (~>> (filter odd?) (map sqr))) - '(25)) - - (test-equal? "~>> (range 5 10 3) [0] ()" - (~>> () (range 5 10 3) (filter odd?) (map sqr)) - '(25)) - - (test-equal? "~>> (range _) [1] (10)" - (~>> (10) (range _) (filter odd?) (map sqr)) - '(1 9 25 49 81)) - (test-equal? "~>> (range _ _) [2] (5 10)" - (~>> (5 10) (range _ _) (filter odd?) (map sqr)) - '(25 49 81)) - (test-equal? "~>> (range _ _ _) [3] (5 10 3)" - (~>> (5 10 3) (range _ _ _) (filter odd?) (map sqr)) - '(25)) - - (test-equal? "~>> (range 5 _) [1] (10)" - (~>> (10) (range 5 _) (filter odd?) (map sqr)) - '(25 49 81)) - (test-equal? "~>> (range _ 10) [1] (5)" - (~>> (5) (range _ 10) (filter odd?) (map sqr)) - '(25 49 81)) - - (test-equal? "~>> (range 5 _ _) [2] (10 3)" - (~>> (10 3) (range 5 _ _) (filter odd?) (map sqr)) - '(25)) - (test-equal? "~>> (range _ 10 _) [2] (5 3)" - (~>> (5 3) (range _ 10 _) (filter odd?) (map sqr)) - '(25)) - (test-equal? "~>> (range _ _ 3) [2] (5 10)" - (~>> (5 10) (range _ _ 3) (filter odd?) (map sqr)) - '(25)) - - (test-equal? "~>> (range 5 10 _) [1] (3)" - (~>> (3) (range 5 10 _) (filter odd?) (map sqr)) - '(25)) - (test-equal? "~>> (range 5 _ 3) [1] (10)" - (~>> (10) (range 5 _ 3) (filter odd?) (map sqr)) - '(25)) - (test-equal? "~>> (range _ 10 3) [1] (5)" - (~>> (5) (range _ 10 3) (filter odd?) (map sqr)) - '(25))) + ;; (test-suite + ;; "range (stream producer)" + ;; ;; Semantic tests of the range producer that cover all combinations: + ;; (test-equal? "~>>range [1-3] (10)" + ;; (~>> (10) range (filter odd?) (map sqr)) + ;; '(1 9 25 49 81)) + ;; (test-equal? "~>range [1-3] (10)" + ;; (~> (10) range (~>> (filter odd?) (map sqr))) + ;; '(1 9 25 49 81)) + ;; (test-equal? "~>> range [1-3] (5 10)" + ;; (~>> (5 10) range (filter odd?) (map sqr)) + ;; '(25 49 81)) + ;; (test-equal? "~> range [1-3] (5 10)" + ;; (~> (5 10) range (~>> (filter odd?) (map sqr))) + ;; '(25 49 81)) + ;; (test-equal? "~>> range [1-3] (5 10 3)" + ;; (~>> (5 10 3) range (filter odd?) (map sqr)) + ;; '(25)) + ;; (test-equal? "~> range [1-3] (5 10 3)" + ;; (~> (5 10 3) range (~>> (filter odd?) (map sqr))) + ;; '(25)) + + ;; (test-equal? "~>> (range 10) [0-2] ()" + ;; (~>> () (range 10) (filter odd?) (map sqr)) + ;; '(1 9 25 49 81)) + ;; (test-equal? "~> (range 10) [0-2] ()" + ;; (~> () (range 10) (~>> (filter odd?) (map sqr))) + ;; '(1 9 25 49 81)) + ;; (test-equal? "~>> (range 5) [0-2] (10)" + ;; (~>> (10) (range 5) (filter odd?) (map sqr)) + ;; '(25 49 81)) + ;; (test-equal? "~> (range 10) [0-2] (5)" + ;; (~> (5) (range 10) (~>> (filter odd?) (map sqr))) + ;; '(25 49 81)) + ;; (test-equal? "~>> (range 3) [0-2] (5 10)" + ;; (~>> (3) (range 5 10) (filter odd?) (map sqr)) + ;; '(25)) + ;; (test-equal? "~> (range 5) [0-2] (10 3)" + ;; (~> (5) (range 10 3) (~>> (filter odd?) (map sqr))) + ;; '(25)) + + ;; (test-equal? "~>> (range 5 10) [0-1] ()" + ;; (~>> () (range 5 10) (filter odd?) (map sqr)) + ;; '(25 49 81)) + ;; (test-equal? "~> (range 5 10) [0-1] ()" + ;; (~> () (range 5 10) (~>> (filter odd?) (map sqr))) + ;; '(25 49 81)) + ;; (test-equal? "~>> (range 5 10) [0-1] (3)" + ;; (~>> (3) (range 5 10) (filter odd?) (map sqr)) + ;; '(25)) + ;; (test-equal? "~> (range 10 3) [0-1] (5)" + ;; (~> (5) (range 10 3) (~>> (filter odd?) (map sqr))) + ;; '(25)) + + ;; (test-equal? "~>> (range 5 10 3) [0] ()" + ;; (~>> () (range 5 10 3) (filter odd?) (map sqr)) + ;; '(25)) + + ;; (test-equal? "~>> (range _) [1] (10)" + ;; (~>> (10) (range _) (filter odd?) (map sqr)) + ;; '(1 9 25 49 81)) + ;; (test-equal? "~>> (range _ _) [2] (5 10)" + ;; (~>> (5 10) (range _ _) (filter odd?) (map sqr)) + ;; '(25 49 81)) + ;; (test-equal? "~>> (range _ _ _) [3] (5 10 3)" + ;; (~>> (5 10 3) (range _ _ _) (filter odd?) (map sqr)) + ;; '(25)) + + ;; (test-equal? "~>> (range 5 _) [1] (10)" + ;; (~>> (10) (range 5 _) (filter odd?) (map sqr)) + ;; '(25 49 81)) + ;; (test-equal? "~>> (range _ 10) [1] (5)" + ;; (~>> (5) (range _ 10) (filter odd?) (map sqr)) + ;; '(25 49 81)) + + ;; (test-equal? "~>> (range 5 _ _) [2] (10 3)" + ;; (~>> (10 3) (range 5 _ _) (filter odd?) (map sqr)) + ;; '(25)) + ;; (test-equal? "~>> (range _ 10 _) [2] (5 3)" + ;; (~>> (5 3) (range _ 10 _) (filter odd?) (map sqr)) + ;; '(25)) + ;; (test-equal? "~>> (range _ _ 3) [2] (5 10)" + ;; (~>> (5 10) (range _ _ 3) (filter odd?) (map sqr)) + ;; '(25)) + + ;; (test-equal? "~>> (range 5 10 _) [1] (3)" + ;; (~>> (3) (range 5 10 _) (filter odd?) (map sqr)) + ;; '(25)) + ;; (test-equal? "~>> (range 5 _ 3) [1] (10)" + ;; (~>> (10) (range 5 _ 3) (filter odd?) (map sqr)) + ;; '(25)) + ;; (test-equal? "~>> (range _ 10 3) [1] (5)" + ;; (~>> (5) (range _ 10 3) (filter odd?) (map sqr)) + ;; '(25))) (test-suite "take (stateful transformer)" (test-equal? "take after filter" - (~>> (20) range (filter odd?) (take _ 5) (map sqr)) + (~>> () (range 20) (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)) + (~>> () (range 20) (filter odd?) (take 5) (take 3) (map sqr)) '(1 9 25)) )))) From c6ee0b4e173292de6a993aeda0f2334426ffd76b Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 17:26:51 -0700 Subject: [PATCH 027/108] register deforestation pass in core --- qi-lib/flow/core/compiler.rkt | 1 + 1 file changed, 1 insertion(+) diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index 27ab37998..c8101307b 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -7,6 +7,7 @@ "compiler/1000-qi0.rkt" "compiler/2000-bindings.rkt" "compiler/0010-normalize.rkt" + "compiler/0100-deforest.rkt" "passes.rkt") (begin-for-syntax From e3eba1130c488087fbc23e31a776752cc47c713e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 17:27:46 -0700 Subject: [PATCH 028/108] Simplify #%deforestable syntax initially Have it just wrap the a priori syntax so that we can transition the functionality to the architecture based on the new core form. --- qi-lib/flow/core/compiler/1000-qi0.rkt | 27 +++++++++++--------- qi-lib/flow/extended/expander.rkt | 4 +-- qi-lib/list.rkt | 35 ++++++++++++++++++++++---- 3 files changed, 46 insertions(+), 20 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index d2e503520..a3233c034 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -4,9 +4,9 @@ (prefix-in fancy: fancy-app) "../impl.rkt" racket/function + "deforest/bindings.rkt" (only-in racket/list - make-list - range) + make-list) (for-syntax racket/base syntax/parse "../syntax.rkt" @@ -398,21 +398,24 @@ the DSL. (define (deforestable-parser stx) (syntax-parse stx - [((~datum #%deforestable) (~datum filter) (proc:clause) (arg:expr ...)) + [((~datum #%deforestable) ((~datum filter) proc:clause)) #'(lambda (v) - (filter (qi0->racket proc) v))] - [((~datum #%deforestable) (~datum map) (proc:clause) (arg:expr ...)) + (filter proc v))] + [((~datum #%deforestable) ((~datum map) proc:clause)) #'(lambda (v) - (map (qi0->racket proc) v))] - [((~datum #%deforestable) (~datum foldl) (proc:clause) (init:expr)) + (map proc v))] + [((~datum #%deforestable) ((~datum foldl) proc:clause init:expr)) #'(lambda (v) - (foldl (qi0->racket proc) init v))] - [((~datum #%deforestable) (~datum foldr) (proc:clause) (init:expr)) + (foldl proc init v))] + [((~datum #%deforestable) ((~datum foldr) proc:clause init:expr)) #'(lambda (v) - (foldr (qi0->racket proc) init v))] - [((~datum #%deforestable) (~datum range) () (arg:expr ...)) + (foldr proc init v))] + [((~datum #%deforestable) ((~datum range) arg:expr ...)) #'(lambda () - (range arg ...))])) + (range arg ...))] + [((~datum #%deforestable) ((~datum take) n:expr)) + #'(lambda (v) + (take v n))])) (define (blanket-template-form-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index f43aca889..dce01277c 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -184,9 +184,7 @@ core language's use of #%app, etc.). (esc ex:racket-expr) ;; core form to express deforestable operations - (#%deforestable name:id - (proc:closed-floe ...) - (arg:racket-expr ...)) + (#%deforestable (name:id arg:racket-expr ...)) ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 0e8ca781f..7a6f7daf4 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -1,8 +1,33 @@ #lang racket/base -;; Upon instantiation of the module it define-and-register-pass for -;; deforestation -(require "flow/core/compiler/0100-deforest.rkt" - "flow/core/compiler/deforest/bindings.rkt") +(provide (for-space qi + (all-defined-out))) -(provide (all-from-out "flow/core/compiler/deforest/bindings.rkt")) +(require (for-syntax racket/base + "private/util.rkt") + syntax/parse/define + "flow/extended/expander.rkt" + "macro.rkt") + +(define-qi-syntax-rule (map f:expr) + (#%deforestable (map f))) + +(define-qi-syntax-rule (filter f:expr) + (#%deforestable (filter f))) + +(define-qi-syntax-rule (foldl f:expr init:expr) + (#%deforestable (foldl f init))) + +(define-qi-syntax-rule (foldr f:expr init:expr) + (#%deforestable (foldr f init))) + +(define-qi-syntax-parser range + [(_ low:expr high:expr step:expr) #'(#%deforestable (range low high step))] + [(_ low:expr high:expr) #'(range low high 1)] + [(_ high:expr) #'(range 0 high 1)] + [_:id (report-syntax-error this-syntax + "(range arg ...)" + "range expects at least one argument")]) + +(define-qi-syntax-rule (take n:expr) + (#%deforestable (take n))) From 0dc8fe421cb1689a218399fbc3737fac678b2cdf Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 17:30:07 -0700 Subject: [PATCH 029/108] modify benchmarks and tests to work with simplified `range` syntax --- qi-lib/private/util.rkt | 12 ++++++++++++ qi-sdk/benchmarks/nonlocal/qi/main.rkt | 20 +++++++++++--------- qi-test/tests/flow.rkt | 15 ++++++++------- 3 files changed, 31 insertions(+), 16 deletions(-) diff --git a/qi-lib/private/util.rkt b/qi-lib/private/util.rkt index 4a6c329aa..35023f5fc 100644 --- a/qi-lib/private/util.rkt +++ b/qi-lib/private/util.rkt @@ -24,6 +24,18 @@ "" (string-append "\n" (string-join msgs "\n")))) + stx)] + [name + (raise-syntax-error name + (~a "Syntax error in " + name + "\n" + "Usage:\n" + " " usage + (if (null? msgs) + "" + (string-append "\n" + (string-join msgs "\n")))) stx)])) (define-syntax-parse-rule (define-alias alias:id name:id) diff --git a/qi-sdk/benchmarks/nonlocal/qi/main.rkt b/qi-sdk/benchmarks/nonlocal/qi/main.rkt index b02a16040..b32fb662c 100644 --- a/qi-sdk/benchmarks/nonlocal/qi/main.rkt +++ b/qi-sdk/benchmarks/nonlocal/qi/main.rkt @@ -18,7 +18,6 @@ double-values) (require (only-in math sqr) - (only-in racket/list range) qi qi/list) @@ -43,8 +42,9 @@ [else (~> (-< sub1 (- 2)) (>< pingala) +)]) -(define-flow (eratosthenes n) - (~> (-< (gen null) (~>> add1 (range 2) △)) +(define (eratosthenes n) + (~> () + (-< (gen null) (~>> (range 2 (add1 n)) △)) (feedback (while (~> (block 1) live?)) (then (~> 1> reverse)) (-< (~> (select 1 2) X cons) @@ -77,19 +77,21 @@ (map sqr) (foldl + 0))) -(define-flow range-map-car - (~>> (range 0) +(define (range-map-car n) + (~>> () + (range 0 n) (map sqr) car)) -(define-flow range-map-sum +(define (range-map-sum n) ;; TODO: this should be written as (apply +) ;; and that should be normalized to (foldr/l + 0) ;; (depending on which of foldl/foldr is more performant) - (~>> (range 0) (map sqr) (foldr + 0))) + (~>> () (range 0 n) (map sqr) (foldr + 0))) -(define-flow long-functional-pipeline - (~>> (range 0) +(define (long-functional-pipeline n) + (~>> () + (range 0 n) (filter odd?) (map sqr) values diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index e13a38181..cdcb648a3 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -287,13 +287,14 @@ "normal racket expressions")) (test-suite "#%deforestable" - (check-equal? ((☯ (#%deforestable filter (odd?) ())) (list 1 2 3)) (list 1 3)) - (check-equal? ((☯ (#%deforestable map (sqr) ())) (list 1 2 3)) (list 1 4 9)) - (check-equal? ((☯ (#%deforestable foldl (+) (0))) (list 1 2 3)) 6) - (check-equal? ((☯ (#%deforestable foldr (+) (0))) (list 1 2 3)) 6) - (check-equal? ((☯ (#%deforestable range () (3)))) (list 0 1 2)) - (check-equal? ((☯ (#%deforestable range () (0 3)))) (list 0 1 2)) - (check-equal? ((☯ (#%deforestable range () (0 5 2)))) (list 0 2 4))) + (check-equal? ((☯ (#%deforestable (filter odd?))) (list 1 2 3)) (list 1 3)) + (check-equal? ((☯ (#%deforestable (map sqr))) (list 1 2 3)) (list 1 4 9)) + (check-equal? ((☯ (#%deforestable (foldl + 0))) (list 1 2 3)) 6) + (check-equal? ((☯ (#%deforestable (foldr + 0))) (list 1 2 3)) 6) + (check-equal? ((☯ (#%deforestable (range 3)))) (list 0 1 2)) + (check-equal? ((☯ (#%deforestable (range 0 3)))) (list 0 1 2)) + (check-equal? ((☯ (#%deforestable (range 0 5 2)))) (list 0 2 4)) + (check-equal? ((☯ (#%deforestable (take 2))) (list 1 2 3)) (list 1 2))) (test-suite "elementary boolean gates" (test-suite From b48a276b9372a9c70a48c47761f96565a598fb5b Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 17:45:53 -0700 Subject: [PATCH 030/108] Match `#%deforestable` in deforesting `map` and `filter` Avoid matching host expressions literally and instead match the newly introduced `#%deforestable` core form. --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 22 ++++--------------- 1 file changed, 4 insertions(+), 18 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index ebe2f6e97..0e5fa519e 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -97,28 +97,14 @@ (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) - _)))) + #:datum-literals (filter) + (pattern (#%deforestable (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) - _)))) + #:datum-literals (map) + (pattern (#%deforestable (map (#%host-expression f))))) (define-syntax-class fst-filter-map #:attributes (f) From 2d878fb3d65259fafc2c2039c2bcd2234102575b Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 17:56:11 -0700 Subject: [PATCH 031/108] Remove tests that ensure only right-threading is deforested As deforestable forms like `map` are now macros (syntax) rather than partial application of host language functions, they are not affected by threading direction. --- qi-test/tests/compiler/semantics.rkt | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/qi-test/tests/compiler/semantics.rkt b/qi-test/tests/compiler/semantics.rkt index aafb82de0..5ae8fd7d9 100644 --- a/qi-test/tests/compiler/semantics.rkt +++ b/qi-test/tests/compiler/semantics.rkt @@ -22,21 +22,6 @@ (check-equal? ((☯ (~>> (filter odd?) (map sqr))) (list 1 2 3 4 5)) (list 1 9 25)) - (check-exn exn:fail? - (thunk - ((☯ (~> (map sqr) (map sqr))) - (list 1 2 3 4 5))) - "(map) doforestation should only be done for right threading") - (check-exn exn:fail? - (thunk - ((☯ (~> (filter odd?) (filter odd?))) - (list 1 2 3 4 5))) - "(filter) doforestation should only be done for right threading") - (check-exn exn:fail? - (thunk - ((☯ (~>> (filter odd?) (~> (foldr + 0)))) - (list 1 2 3 4 5))) - "(foldr) doforestation should only be done for right threading") (check-equal? ((☯ (~>> values (filter odd?) (map sqr) values)) (list 1 2 3 4 5)) (list 1 9 25) From 580b380328bd63ee0f043748512843becb0d3e48 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 18:21:10 -0700 Subject: [PATCH 032/108] Match `#%deforestable` in `foldl` and `foldr` --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 28 ++++++------------- 1 file changed, 8 insertions(+), 20 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 0e5fa519e..037641127 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -153,32 +153,20 @@ (define-syntax-class fsc-foldr #:attributes (op init) #:literal-sets (fs-literals) - #:literals (qi:foldr) - (pattern (#%blanket-template - ((#%host-expression qi:foldr) + #:datum-literals (foldr) + (pattern (#%deforestable + (foldr (#%host-expression op) - (#%host-expression init) - __))) - (pattern (#%fine-template - ((#%host-expression qi:foldr) - (#%host-expression op) - (#%host-expression init) - _)))) + (#%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) + #:datum-literals (foldl) + (pattern (#%deforestable + (foldl (#%host-expression op) - (#%host-expression init) - __))) - (pattern (#%fine-template - ((#%host-expression qi:foldl) - (#%host-expression op) - (#%host-expression init) - _)))) + (#%host-expression init))))) (define-syntax-class cad*r-datum #:attributes (countdown) From 0269159d2ca7c9776f2b19526147eb645ff8cda9 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 18:42:52 -0700 Subject: [PATCH 033/108] Match `#%deforestable` in deforesting `car` --- qi-lib/flow/core/compiler/1000-qi0.rkt | 4 +++- qi-lib/flow/core/compiler/deforest/syntax.rkt | 5 +++-- qi-lib/flow/extended/expander.rkt | 1 + qi-lib/list.rkt | 3 +++ 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index a3233c034..c79e6e7d6 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -415,7 +415,9 @@ the DSL. (range arg ...))] [((~datum #%deforestable) ((~datum take) n:expr)) #'(lambda (v) - (take v n))])) + (take v n))] + [((~datum #%deforestable) (~datum car)) + #'car])) (define (blanket-template-form-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 037641127..535083e22 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -170,7 +170,7 @@ (define-syntax-class cad*r-datum #:attributes (countdown) - (pattern (~literal qi:car) #:attr countdown #'0) + (pattern (#%deforestable (~datum 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)) @@ -189,7 +189,8 @@ (#%fine-template ((#%host-expression cad*r:cad*r-datum) _)) (#%blanket-template - ((#%host-expression cad*r:cad*r-datum) __))) + ((#%host-expression cad*r:cad*r-datum) __)) + cad*r:cad*r-datum) #:attr pos #'cad*r.countdown #:attr name #'cad*r)) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index dce01277c..f3fee53e4 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -185,6 +185,7 @@ core language's use of #%app, etc.). ;; core form to express deforestable operations (#%deforestable (name:id arg:racket-expr ...)) + (#%deforestable name:id) ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 7a6f7daf4..ca1de96e5 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -31,3 +31,6 @@ (define-qi-syntax-rule (take n:expr) (#%deforestable (take n))) + +(define-qi-syntax-parser car + [_:id #'(#%deforestable car)]) From c6dfd57acbebb84608d3f7f76f5c38445ab78719 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 18:50:44 -0700 Subject: [PATCH 034/108] Use `#%deforestable` in `cadr`, `caddr`, `cadddr` --- qi-lib/flow/core/compiler/1000-qi0.rkt | 8 +++++++- qi-lib/flow/core/compiler/deforest/syntax.rkt | 13 ++++--------- qi-lib/list.rkt | 9 +++++++++ 3 files changed, 20 insertions(+), 10 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index c79e6e7d6..d66be13c8 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -417,7 +417,13 @@ the DSL. #'(lambda (v) (take v n))] [((~datum #%deforestable) (~datum car)) - #'car])) + #'car] + [((~datum #%deforestable) (~datum cadr)) + #'cadr] + [((~datum #%deforestable) (~datum caddr)) + #'caddr] + [((~datum #%deforestable) (~datum cadddr)) + #'cadddr])) (define (blanket-template-form-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 535083e22..051d56778 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -171,9 +171,9 @@ (define-syntax-class cad*r-datum #:attributes (countdown) (pattern (#%deforestable (~datum 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)) + (pattern (#%deforestable (~datum cadr)) #:attr countdown #'1) + (pattern (#%deforestable (~datum caddr)) #:attr countdown #'2) + (pattern (#%deforestable (~datum cadddr)) #:attr countdown #'3)) (define-syntax-class fsc-list-ref #:attributes (pos name) @@ -185,12 +185,7 @@ ((#%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) __)) - cad*r:cad*r-datum) + (pattern cad*r:cad*r-datum #:attr pos #'cad*r.countdown #:attr name #'cad*r)) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index ca1de96e5..d43de1487 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -34,3 +34,12 @@ (define-qi-syntax-parser car [_:id #'(#%deforestable car)]) + +(define-qi-syntax-parser cadr + [_:id #'(#%deforestable cadr)]) + +(define-qi-syntax-parser caddr + [_:id #'(#%deforestable caddr)]) + +(define-qi-syntax-parser cadddr + [_:id #'(#%deforestable cadddr)]) From 33f2b58f27704f5c0318bfb0926b854d40e56953 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 19:03:19 -0700 Subject: [PATCH 035/108] Use `#%deforestable` in `list-ref` --- qi-lib/flow/core/compiler/1000-qi0.rkt | 5 ++++- qi-lib/flow/core/compiler/deforest/syntax.rkt | 7 ++----- qi-lib/list.rkt | 3 +++ 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index d66be13c8..c43c52174 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -423,7 +423,10 @@ the DSL. [((~datum #%deforestable) (~datum caddr)) #'caddr] [((~datum #%deforestable) (~datum cadddr)) - #'cadddr])) + #'cadddr] + [((~datum #%deforestable) ((~datum list-ref) n:expr)) + #'(lambda (v) + (list-ref v n))])) (define (blanket-template-form-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 051d56778..91259e79c 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -178,11 +178,8 @@ (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))) + #:datum-literals (list-ref) + (pattern (#%deforestable (list-ref idx)) #:attr pos #'idx #:attr name #'list-ref) (pattern cad*r:cad*r-datum diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index d43de1487..c542c010a 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -43,3 +43,6 @@ (define-qi-syntax-parser cadddr [_:id #'(#%deforestable cadddr)]) + +(define-qi-syntax-rule (list-ref n:expr) + (#%deforestable (list-ref n))) From 9c9ff0a43be6e067e2ece5c67bcc273876955a70 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 19:08:38 -0700 Subject: [PATCH 036/108] Use `#%deforestable` in `length` --- qi-lib/flow/core/compiler/1000-qi0.rkt | 4 +++- qi-lib/flow/core/compiler/deforest/syntax.rkt | 9 ++------- qi-lib/list.rkt | 3 +++ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index c43c52174..50381567a 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -426,7 +426,9 @@ the DSL. #'cadddr] [((~datum #%deforestable) ((~datum list-ref) n:expr)) #'(lambda (v) - (list-ref v n))])) + (list-ref v n))] + [((~datum #%deforestable) (~datum length)) + #'length])) (define (blanket-template-form-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 91259e79c..25c1a1dd8 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -188,13 +188,8 @@ (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) __)))) + #:datum-literals (length) + (pattern (#%deforestable length))) (define-syntax-class fsc-empty? #:literal-sets (fs-literals) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index c542c010a..7b4427e7d 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -46,3 +46,6 @@ (define-qi-syntax-rule (list-ref n:expr) (#%deforestable (list-ref n))) + +(define-qi-syntax-parser length + [_:id #'(#%deforestable length)]) From 208aa1baacc806cb139e94de99788b68f6aa2633 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 10 Jul 2024 19:16:11 -0700 Subject: [PATCH 037/108] Use `#%deforestable` in `empty?` and `null?` --- qi-lib/flow/core/compiler/1000-qi0.rkt | 4 +++- qi-lib/flow/core/compiler/deforest/syntax.rkt | 13 +++---------- qi-lib/list.rkt | 7 +++++++ 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 50381567a..cc2970991 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -428,7 +428,9 @@ the DSL. #'(lambda (v) (list-ref v n))] [((~datum #%deforestable) (~datum length)) - #'length])) + #'length] + [((~datum #%deforestable) (~or* (~datum empty?) (~datum null?))) + #'empty?])) (define (blanket-template-form-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 25c1a1dd8..b099cc6b9 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -193,16 +193,9 @@ (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?)) __)))) + #:datum-literals (null? empty?) + (pattern (#%deforestable (~or empty? + null?)))) (define-syntax-class fsc-default #:datum-literals (cstream->list) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 7b4427e7d..1b45faedb 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -7,6 +7,8 @@ "private/util.rkt") syntax/parse/define "flow/extended/expander.rkt" + (only-in "flow/space.rkt" + define-qi-alias) "macro.rkt") (define-qi-syntax-rule (map f:expr) @@ -49,3 +51,8 @@ (define-qi-syntax-parser length [_:id #'(#%deforestable length)]) + +(define-qi-syntax-parser empty? + [_:id #'(#%deforestable empty?)]) + +(define-qi-alias null? empty?) From d3535b5f85b28ba943afc358ec89677c00e111e7 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 11 Jul 2024 08:36:56 -0700 Subject: [PATCH 038/108] Write `filter-map` as a macro expanding to `#%deforestable` --- qi-lib/flow/core/compiler/1000-qi0.rkt | 3 +++ qi-lib/flow/core/compiler/deforest/syntax.rkt | 11 ++--------- qi-lib/list.rkt | 3 +++ 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index cc2970991..2e401833f 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -401,6 +401,9 @@ the DSL. [((~datum #%deforestable) ((~datum filter) proc:clause)) #'(lambda (v) (filter proc v))] + [((~datum #%deforestable) ((~datum filter-map) proc:clause)) + #'(lambda (v) + (filter-map proc v))] [((~datum #%deforestable) ((~datum map) proc:clause)) #'(lambda (v) (map proc v))] diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index b099cc6b9..c67dbd8af 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -109,15 +109,8 @@ (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) - _)))) + #:datum-literals (filter-map) + (pattern (#%deforestable (filter-map (#%host-expression f))))) (define-syntax-class fst-take #:attributes (n) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 1b45faedb..d7c932281 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -17,6 +17,9 @@ (define-qi-syntax-rule (filter f:expr) (#%deforestable (filter f))) +(define-qi-syntax-rule (filter-map f:expr) + (#%deforestable (filter-map f))) + (define-qi-syntax-rule (foldl f:expr init:expr) (#%deforestable (foldl f init))) From a89093185584a7d83e8e4712abd0674d4538c849 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 11 Jul 2024 08:39:56 -0700 Subject: [PATCH 039/108] Match `#%deforestable` in deforesting take instead of a host expression --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index c67dbd8af..c12384d9b 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -115,15 +115,8 @@ (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))))) + #:datum-literals (take) + (pattern (#%deforestable (take (#%host-expression n))))) (define-syntax-class fst-syntax0 (pattern (~or filter:fst-filter From 1130b8d18160f2d858b6193d96b1f62f95df521e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 11 Jul 2024 08:54:54 -0700 Subject: [PATCH 040/108] simplify `range` syntax matching for now --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 32 ++++--------------- 1 file changed, 7 insertions(+), 25 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index c12384d9b..d66d607ce 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -50,31 +50,13 @@ (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)) + #:datum-literals (range) + (pattern (#%deforestable (range the-arg ...)) + #:attr arg #'(the-arg ...) + #:attr pre-arg #f + #:attr post-arg #f + #:attr blanket? #f + #:attr fine? #f)) (define-syntax-class fsp-default #:datum-literals (list->cstream) From 11eef9eddaf959b73c33e150705de36d82c348cf Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 11 Jul 2024 09:06:48 -0700 Subject: [PATCH 041/108] mysterious fix for test errors --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index d66d607ce..26f35deaf 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -56,7 +56,7 @@ #:attr pre-arg #f #:attr post-arg #f #:attr blanket? #f - #:attr fine? #f)) + #:attr fine? #t)) (define-syntax-class fsp-default #:datum-literals (list->cstream) From 78e57c5021d5836de2248ad64b34c1280ddbb4f7 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 11 Jul 2024 17:41:31 -0700 Subject: [PATCH 042/108] lint.. --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 26f35deaf..31bd6ca25 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -101,8 +101,8 @@ (pattern (#%deforestable (take (#%host-expression n))))) (define-syntax-class fst-syntax0 - (pattern (~or filter:fst-filter - filter-map:fst-filter-map))) + (pattern (~or _:fst-filter + _:fst-filter-map))) (define-syntax-class fst-syntax (pattern (~or _:fst-filter From 5314024c8371c35ee20bb256d7d08f53e677f615 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 11 Jul 2024 22:22:57 -0700 Subject: [PATCH 043/108] A few basic tests for deforested forms --- qi-test/tests/compiler/rules/deforest.rkt | 205 ++++++++++++------ .../compiler/rules/private/deforest-util.rkt | 36 ++- qi-test/tests/compiler/semantics.rkt | 55 +++++ 3 files changed, 233 insertions(+), 63 deletions(-) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index 3d832e183..23da3656d 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -34,6 +34,11 @@ (deforest-pass (expand-flow stx)))))) +(define-syntax-parse-rule (test-deforest stx) + (phase1-eval + (deforest-pass + (expand-flow stx)))) + (define tests @@ -78,71 +83,149 @@ (test-suite "transformers" - (test-deforested "filter-map (two transformers)" + (test-deforested "filter->map (two transformers)" #'(~>> (filter odd?) (map sqr))) - ;; (test-deforested "fine-grained template forms" - ;; #'(~>> (filter odd? _) (map sqr _))) - ) + (test-suite + "filter" + (test-true "filter" + (filter-deforested? + (test-deforest + #'(~>> (filter odd?) (map sqr)))))) + (test-suite + "map" + (test-true "map" + (map-deforested? + (test-deforest + #'(~>> (filter odd?) (map sqr)))))) + (test-suite + "filter-map" + (test-true "filter-map" + (filter-map-deforested? + (test-deforest + #'(~>> (filter odd?) (filter-map sqr)))))) + (test-suite + "take" + (test-true "take" + (take-deforested? + (test-deforest + #'(~>> (filter odd?) (take 3))))))) - ;; (test-suite - ;; "producers" - ;; ;; TODO: note that these uses of `range` are matched as datums - ;; ;; and requiring racket/list's range is not required in this module - ;; ;; for deforestation to happen. This should be changed to use - ;; ;; literal matching in the compiler. - ;; (test-deforested "range" - ;; #'(~>> range (filter odd?))) - ;; (test-deforested "(range _)" - ;; #'(~>> (range _) (filter odd?))) - ;; (test-deforested "(range _ _)" - ;; #'(~>> (range _ _) (filter odd?))) - ;; (test-deforested "(range 0 _)" - ;; #'(~>> (range 0 _) (filter odd?))) - ;; (test-deforested "(range _ 10)" - ;; #'(~>> (range _ 10) (filter odd?))) - ;; (test-deforested "(range _ _ _)" - ;; #'(~>> (range _ _ _) (filter odd?))) - ;; (test-deforested "(range _ _ 1)" - ;; #'(~>> (range _ _ 1) (filter odd?))) - ;; (test-deforested "(range _ 10 _)" - ;; #'(~>> (range _ 10 _) (filter odd?))) - ;; (test-deforested "(range _ 10 1)" - ;; #'(~>> (range _ 10 1) (filter odd?))) - ;; (test-deforested "(range 0 _ _)" - ;; #'(~>> (range 0 _ _) (filter odd?))) - ;; (test-deforested "(range 0 _ 1)" - ;; #'(~>> (range 0 _ 1) (filter odd?))) - ;; (test-deforested "(range 0 10 _)" - ;; #'(~>> (range 0 10 _) (filter odd? __))) - ;; (test-deforested "(range __)" - ;; #'(~>> (range __) (filter odd?))) - ;; (test-deforested "(range 0 __)" - ;; #'(~>> (range 0 __) (filter odd?))) - ;; (test-deforested "(range __ 1)" - ;; #'(~>> (range __ 1) (filter odd?))) - ;; (test-deforested "(range 0 10 __)" - ;; #'(~>> (range 0 10 __) (filter odd?))) - ;; (test-deforested "(range __ 10 1)" - ;; #'(~>> (range __ 10 1) (filter odd? __))) - ;; (test-deforested "(range 0 __ 1)" - ;; #'(~>> (range 0 __ 1) (filter odd?))) - ;; (test-deforested "(range 0 10 1 __)" - ;; #'(~>> (range 0 10 1 __) (filter odd?))) - ;; (test-deforested "(range 0 10 __ 1)" - ;; #'(~>> (range 0 10 __ 1) (filter odd?))) - ;; (test-deforested "(range 0 __ 10 1)" - ;; #'(~>> (range 0 __ 10 1) (filter odd?))) - ;; (test-deforested "(range __ 0 10 1)" - ;; #'(~>> (range __ 0 10 1) (filter odd?)))) + (test-suite + "producers" + (test-suite + "range" + (test-deforested "range" + #'(~> (range 10) (filter odd?))) + (test-true "range" + (range-deforested? + (test-deforest + #'(~> (range 10) (filter odd?)))))) + ;; (test-suite + ;; "range" + ;; ;; TODO: note that these uses of `range` are matched as datums + ;; ;; and requiring racket/list's range is not required in this module + ;; ;; for deforestation to happen. This should be changed to use + ;; ;; literal matching in the compiler. + ;; (test-deforested "range" + ;; #'(~>> range (filter odd?))) + ;; (test-deforested "(range _)" + ;; #'(~>> (range _) (filter odd?))) + ;; (test-deforested "(range _ _)" + ;; #'(~>> (range _ _) (filter odd?))) + ;; (test-deforested "(range 0 _)" + ;; #'(~>> (range 0 _) (filter odd?))) + ;; (test-deforested "(range _ 10)" + ;; #'(~>> (range _ 10) (filter odd?))) + ;; (test-deforested "(range _ _ _)" + ;; #'(~>> (range _ _ _) (filter odd?))) + ;; (test-deforested "(range _ _ 1)" + ;; #'(~>> (range _ _ 1) (filter odd?))) + ;; (test-deforested "(range _ 10 _)" + ;; #'(~>> (range _ 10 _) (filter odd?))) + ;; (test-deforested "(range _ 10 1)" + ;; #'(~>> (range _ 10 1) (filter odd?))) + ;; (test-deforested "(range 0 _ _)" + ;; #'(~>> (range 0 _ _) (filter odd?))) + ;; (test-deforested "(range 0 _ 1)" + ;; #'(~>> (range 0 _ 1) (filter odd?))) + ;; (test-deforested "(range 0 10 _)" + ;; #'(~>> (range 0 10 _) (filter odd? __))) + ;; (test-deforested "(range __)" + ;; #'(~>> (range __) (filter odd?))) + ;; (test-deforested "(range 0 __)" + ;; #'(~>> (range 0 __) (filter odd?))) + ;; (test-deforested "(range __ 1)" + ;; #'(~>> (range __ 1) (filter odd?))) + ;; (test-deforested "(range 0 10 __)" + ;; #'(~>> (range 0 10 __) (filter odd?))) + ;; (test-deforested "(range __ 10 1)" + ;; #'(~>> (range __ 10 1) (filter odd? __))) + ;; (test-deforested "(range 0 __ 1)" + ;; #'(~>> (range 0 __ 1) (filter odd?))) + ;; (test-deforested "(range 0 10 1 __)" + ;; #'(~>> (range 0 10 1 __) (filter odd?))) + ;; (test-deforested "(range 0 10 __ 1)" + ;; #'(~>> (range 0 10 __ 1) (filter odd?))) + ;; (test-deforested "(range 0 __ 10 1)" + ;; #'(~>> (range 0 __ 10 1) (filter odd?))) + ;; (test-deforested "(range __ 0 10 1)" + ;; #'(~>> (range __ 0 10 1) (filter odd?)))) + ) (test-suite "consumers" - (test-deforested "car" - #'(~>> (filter odd?) car)) - (test-deforested "foldl" - #'(~>> (filter string-upcase) (foldl string-append "I"))) - (test-deforested "foldr" - #'(~>> (filter string-upcase) (foldr string-append "I"))))) + (test-suite + "list-ref" + (test-deforested "car" + #'(~>> (filter odd?) car)) + (test-true "car" + (list-ref-deforested? + (test-deforest + #'(~>> (filter odd?) car)))) + (test-deforested "list-ref" + #'(~>> (filter odd?) (list-ref 2))) + (test-true "list-ref" + (list-ref-deforested? + (test-deforest + #'(~>> (filter odd?) (list-ref 2)))))) + (test-suite + "foldl" + (test-deforested "foldl" + #'(~>> (filter non-empty-string?) (foldl string-append "I"))) + (test-true "foldl" + (foldl-deforested? + (test-deforest + #'(~>> (filter non-empty-string?) (foldl string-append "I")))))) + (test-suite + "foldr" + (test-deforested "foldr" + #'(~>> (filter non-empty-string?) (foldr string-append "I"))) + (test-true "foldr" + (foldr-deforested? + (test-deforest + #'(~>> (filter non-empty-string?) (foldr string-append "I")))))) + (test-suite + "length" + (test-deforested "length" + #'(~>> (filter non-empty-string?) length)) + (test-true "length" + (length-deforested? + (test-deforest + #'(~>> (filter non-empty-string?) length))))) + (test-suite + "empty?" + (test-deforested "empty?" + #'(~>> (filter non-empty-string?) empty?)) + (test-true "empty?" + (empty?-deforested? + (test-deforest + #'(~>> (filter non-empty-string?) empty?)))) + (test-deforested "null?" + #'(~>> (filter non-empty-string?) null?)) + (test-true "null?" + (empty?-deforested? + (test-deforest + #'(~>> (filter non-empty-string?) null?))))))) (test-suite "deforest-pass" @@ -161,7 +244,7 @@ ;; (test-true "multiple independent positions" ;; (filter-deforested? stx)) ;; (test-true "multiple independent positions" - ;; (car-deforested? stx))) + ;; (list-ref-deforested? stx))) ))) (module+ main diff --git a/qi-test/tests/compiler/rules/private/deforest-util.rkt b/qi-test/tests/compiler/rules/private/deforest-util.rkt index 4ab71c7de..0b7d0230b 100644 --- a/qi-test/tests/compiler/rules/private/deforest-util.rkt +++ b/qi-test/tests/compiler/rules/private/deforest-util.rkt @@ -1,8 +1,16 @@ #lang racket/base (provide deforested? + range-deforested? filter-deforested? - car-deforested?) + map-deforested? + filter-map-deforested? + take-deforested? + foldl-deforested? + foldr-deforested? + length-deforested? + empty?-deforested? + list-ref-deforested?) ;; Note: an alternative way to make these assertions could be to add logging ;; to compiler passes to trace what happens to a source expression, capturing @@ -16,8 +24,32 @@ (define (deforested? exp) (string-contains? (format "~a" exp) "cstream")) +(define (range-deforested? exp) + (string-contains? (format "~a" exp) "range->cstream")) + (define (filter-deforested? exp) (string-contains? (format "~a" exp) "filter-cstream")) -(define (car-deforested? exp) +(define (map-deforested? exp) + (string-contains? (format "~a" exp) "map-cstream")) + +(define (filter-map-deforested? exp) + (string-contains? (format "~a" exp) "filter-map-cstream")) + +(define (take-deforested? exp) + (string-contains? (format "~a" exp) "take-cstream")) + +(define (foldl-deforested? exp) + (string-contains? (format "~a" exp) "foldl-cstream")) + +(define (foldr-deforested? exp) + (string-contains? (format "~a" exp) "foldr-cstream")) + +(define (length-deforested? exp) + (string-contains? (format "~a" exp) "length-cstream")) + +(define (empty?-deforested? exp) + (string-contains? (format "~a" exp) "empty?-cstream")) + +(define (list-ref-deforested? exp) (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 5ae8fd7d9..6d5172112 100644 --- a/qi-test/tests/compiler/semantics.rkt +++ b/qi-test/tests/compiler/semantics.rkt @@ -8,6 +8,7 @@ (only-in math sqr) qi/list syntax/macro-testing + racket/string racket/function) (define tests @@ -170,6 +171,60 @@ ;; (~>> (5) (range _ 10 3) (filter odd?) (map sqr)) ;; '(25))) + (test-suite + "range" + (test-equal? "range" + (~> () (range 10) (filter odd?)) + '(1 3 5 7 9))) + (test-suite + "filter" + (test-equal? "filter" + (~> () (range 10) (filter odd?)) + '(1 3 5 7 9))) + (test-suite + "map" + (test-equal? "map" + (~> () (range 4) (map sqr)) + '(0 1 4 9))) + (test-suite + "filter-map" + (test-equal? "filter-map" + (~> () (range 4) (filter-map sqr)) + '(0 1 4 9))) + (test-suite + "foldl" + (test-equal? "foldl" + (~> ((list "a" "b" "c")) (filter non-empty-string?) (foldl string-append "")) + "cba")) + (test-suite + "foldr" + (test-equal? "foldr" + (~> ((list "a" "b" "c")) (filter non-empty-string?) (foldr string-append "")) + "abc")) + (test-suite + "list-ref" + (test-equal? "car" + (~> () (range 10) car) + 0) + (test-equal? "list-ref" + (~> () (range 10) (list-ref 2)) + 2)) + (test-suite + "length" + (test-equal? "length" + (~> () (range 10) length) + 10)) + (test-suite + "empty?" + (test-false "empty?" + (~> () (range 10) empty?)) + (test-true "empty?" + (~> () (range 0) empty?)) + (test-false "null?" + (~> () (range 10) null?)) + (test-true "null?" + (~> () (range 0) null?))) + (test-suite "take (stateful transformer)" (test-equal? "take after filter" From cecd4e17ba2359c33bb14451064774992253f925 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 2 Aug 2024 09:48:44 -0700 Subject: [PATCH 044/108] Codegen floe positions in #%deforestable The function positions in deforestable operations are Racket expr positions, but we want them to be Qi floe positions instead. This modifies the code generation step to recursively invoke codegen on these nested floe positions. --- qi-lib/flow/core/compiler/1000-qi0.rkt | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 2e401833f..bf7a7a3d2 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -400,19 +400,19 @@ the DSL. (syntax-parse stx [((~datum #%deforestable) ((~datum filter) proc:clause)) #'(lambda (v) - (filter proc v))] + (filter (qi0->racket proc) v))] [((~datum #%deforestable) ((~datum filter-map) proc:clause)) #'(lambda (v) - (filter-map proc v))] + (filter-map (qi0->racket proc) v))] [((~datum #%deforestable) ((~datum map) proc:clause)) #'(lambda (v) - (map proc v))] + (map (qi0->racket proc) v))] [((~datum #%deforestable) ((~datum foldl) proc:clause init:expr)) #'(lambda (v) - (foldl proc init v))] + (foldl (qi0->racket proc) init v))] [((~datum #%deforestable) ((~datum foldr) proc:clause init:expr)) #'(lambda (v) - (foldr proc init v))] + (foldr (qi0->racket proc) init v))] [((~datum #%deforestable) ((~datum range) arg:expr ...)) #'(lambda () (range arg ...))] From 28c2408797b4782ab6bc5a6b906c2f2729510950 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 2 Aug 2024 11:09:21 -0700 Subject: [PATCH 045/108] New syntax for `#%deforestable` distinguishing `floe` positions Based on recent discussions, as a general maxim: Our core language should be rich enough to express desired optimizations. Initially, as this wasn't the case, we were performing deforestation by matching host language forms. This of course meant that we were constrained to Racket syntax in such functional operations. Now that we are broadening our core language to express deforestation, in keeping with the above maxim, we would prefer to support Qi syntax in function positions in these operations. Towards this goal, this new syntax for the `#%deforestable` core form introduces support for `floe` positions. Right now, it simply segregates arguments into `expr` and `floe` positions so that these are appropriately expanded. The code generation still matches the name of the functional list transformation (e.g. `map`, `filter`) and "hardcodes" the known invocation of the corresponding underlying operation. Eventually we hope to make deforestation user-extensible to arbitrary functional list (at least) operations. At that stage, we wouldn't have this kind of standard information that we could leverage during code generation, so we will need to modify the syntax of `#%deforestable` to encode enough information to be able to perform appropriate code generation for arbitrary user-defined operations. We are not there yet :) --- qi-lib/flow/extended/expander.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index f3fee53e4..580c138d3 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -184,7 +184,8 @@ core language's use of #%app, etc.). (esc ex:racket-expr) ;; core form to express deforestable operations - (#%deforestable (name:id arg:racket-expr ...)) + (#%deforestable name:id (f:closed-floe ...) (arg:racket-expr ...)) + (#%deforestable name:id (f:closed-floe ...+)) (#%deforestable name:id) ;; backwards compat macro extensibility via Racket macros From c3e099f9c61debb2fb5c633788c39a89efc51746 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 2 Aug 2024 16:21:02 -0700 Subject: [PATCH 046/108] Use the new `#%deforestable` syntax --- qi-lib/flow/core/compiler/1000-qi0.rkt | 16 ++++----- qi-lib/flow/core/compiler/deforest/syntax.rkt | 34 ++++++++++--------- qi-lib/list.rkt | 20 +++++------ qi-test/tests/flow.rkt | 16 ++++----- 4 files changed, 44 insertions(+), 42 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index bf7a7a3d2..20ca0de9d 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -398,25 +398,25 @@ the DSL. (define (deforestable-parser stx) (syntax-parse stx - [((~datum #%deforestable) ((~datum filter) proc:clause)) + [((~datum #%deforestable) (~datum filter) (proc:clause)) #'(lambda (v) (filter (qi0->racket proc) v))] - [((~datum #%deforestable) ((~datum filter-map) proc:clause)) + [((~datum #%deforestable) (~datum filter-map) (proc:clause)) #'(lambda (v) (filter-map (qi0->racket proc) v))] - [((~datum #%deforestable) ((~datum map) proc:clause)) + [((~datum #%deforestable) (~datum map) (proc:clause)) #'(lambda (v) (map (qi0->racket proc) v))] - [((~datum #%deforestable) ((~datum foldl) proc:clause init:expr)) + [((~datum #%deforestable) (~datum foldl) (proc:clause) (init:expr)) #'(lambda (v) (foldl (qi0->racket proc) init v))] - [((~datum #%deforestable) ((~datum foldr) proc:clause init:expr)) + [((~datum #%deforestable) (~datum foldr) (proc:clause) (init:expr)) #'(lambda (v) (foldr (qi0->racket proc) init v))] - [((~datum #%deforestable) ((~datum range) arg:expr ...)) + [((~datum #%deforestable) (~datum range) () (arg:expr ...)) #'(lambda () (range arg ...))] - [((~datum #%deforestable) ((~datum take) n:expr)) + [((~datum #%deforestable) (~datum take) () (n:expr)) #'(lambda (v) (take v n))] [((~datum #%deforestable) (~datum car)) @@ -427,7 +427,7 @@ the DSL. #'caddr] [((~datum #%deforestable) (~datum cadddr)) #'cadddr] - [((~datum #%deforestable) ((~datum list-ref) n:expr)) + [((~datum #%deforestable) (~datum list-ref) () (n:expr)) #'(lambda (v) (list-ref v n))] [((~datum #%deforestable) (~datum length)) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 31bd6ca25..707db6c1c 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -51,7 +51,7 @@ #:attributes (blanket? fine? arg pre-arg post-arg) #:literal-sets (fs-literals) #:datum-literals (range) - (pattern (#%deforestable (range the-arg ...)) + (pattern (#%deforestable range () (the-arg ...)) #:attr arg #'(the-arg ...) #:attr pre-arg #f #:attr post-arg #f @@ -80,25 +80,25 @@ #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter) - (pattern (#%deforestable (filter (#%host-expression f))))) + (pattern (#%deforestable filter (f)))) (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (map) - (pattern (#%deforestable (map (#%host-expression f))))) + (pattern (#%deforestable map (f)))) (define-syntax-class fst-filter-map #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter-map) - (pattern (#%deforestable (filter-map (#%host-expression f))))) + (pattern (#%deforestable filter-map (f)))) (define-syntax-class fst-take #:attributes (n) #:literal-sets (fs-literals) #:datum-literals (take) - (pattern (#%deforestable (take (#%host-expression n))))) + (pattern (#%deforestable take () ((#%host-expression n))))) (define-syntax-class fst-syntax0 (pattern (~or _:fst-filter @@ -123,18 +123,18 @@ #:literal-sets (fs-literals) #:datum-literals (foldr) (pattern (#%deforestable - (foldr - (#%host-expression op) - (#%host-expression init))))) + foldr + (op) + ((#%host-expression init))))) (define-syntax-class fsc-foldl #:attributes (op init) #:literal-sets (fs-literals) #:datum-literals (foldl) (pattern (#%deforestable - (foldl - (#%host-expression op) - (#%host-expression init))))) + foldl + (op) + ((#%host-expression init))))) (define-syntax-class cad*r-datum #:attributes (countdown) @@ -147,12 +147,14 @@ #:attributes (pos name) #:literal-sets (fs-literals) #:datum-literals (list-ref) - (pattern (#%deforestable (list-ref idx)) - #:attr pos #'idx - #:attr name #'list-ref) + ;; TODO: need #%host-expression wrapping idx? + (pattern (#%deforestable list-ref () (idx)) + #:attr pos #'idx + #:attr name #'list-ref) + ;; TODO: bring wrapping #%deforestable out here? (pattern cad*r:cad*r-datum - #:attr pos #'cad*r.countdown - #:attr name #'cad*r)) + #:attr pos #'cad*r.countdown + #:attr name #'cad*r)) (define-syntax-class fsc-length #:literal-sets (fs-literals) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index d7c932281..93b4b5759 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -12,30 +12,30 @@ "macro.rkt") (define-qi-syntax-rule (map f:expr) - (#%deforestable (map f))) + (#%deforestable map (f))) (define-qi-syntax-rule (filter f:expr) - (#%deforestable (filter f))) + (#%deforestable filter (f))) (define-qi-syntax-rule (filter-map f:expr) - (#%deforestable (filter-map f))) + (#%deforestable filter-map (f))) (define-qi-syntax-rule (foldl f:expr init:expr) - (#%deforestable (foldl f init))) + (#%deforestable foldl (f) (init))) (define-qi-syntax-rule (foldr f:expr init:expr) - (#%deforestable (foldr f init))) + (#%deforestable foldr (f) (init))) (define-qi-syntax-parser range - [(_ low:expr high:expr step:expr) #'(#%deforestable (range low high step))] - [(_ low:expr high:expr) #'(range low high 1)] - [(_ high:expr) #'(range 0 high 1)] + [(_ low:expr high:expr step:expr) #'(#%deforestable range () (low high step))] + [(_ low:expr high:expr) #'(#%deforestable range () (low high 1))] + [(_ high:expr) #'(#%deforestable range () (0 high 1))] [_:id (report-syntax-error this-syntax "(range arg ...)" "range expects at least one argument")]) (define-qi-syntax-rule (take n:expr) - (#%deforestable (take n))) + (#%deforestable take () (n))) (define-qi-syntax-parser car [_:id #'(#%deforestable car)]) @@ -50,7 +50,7 @@ [_:id #'(#%deforestable cadddr)]) (define-qi-syntax-rule (list-ref n:expr) - (#%deforestable (list-ref n))) + (#%deforestable list-ref () (n))) (define-qi-syntax-parser length [_:id #'(#%deforestable length)]) diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index cdcb648a3..67cc4f0e8 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -287,14 +287,14 @@ "normal racket expressions")) (test-suite "#%deforestable" - (check-equal? ((☯ (#%deforestable (filter odd?))) (list 1 2 3)) (list 1 3)) - (check-equal? ((☯ (#%deforestable (map sqr))) (list 1 2 3)) (list 1 4 9)) - (check-equal? ((☯ (#%deforestable (foldl + 0))) (list 1 2 3)) 6) - (check-equal? ((☯ (#%deforestable (foldr + 0))) (list 1 2 3)) 6) - (check-equal? ((☯ (#%deforestable (range 3)))) (list 0 1 2)) - (check-equal? ((☯ (#%deforestable (range 0 3)))) (list 0 1 2)) - (check-equal? ((☯ (#%deforestable (range 0 5 2)))) (list 0 2 4)) - (check-equal? ((☯ (#%deforestable (take 2))) (list 1 2 3)) (list 1 2))) + (check-equal? ((☯ (#%deforestable filter (odd?))) (list 1 2 3)) (list 1 3)) + (check-equal? ((☯ (#%deforestable map (sqr))) (list 1 2 3)) (list 1 4 9)) + (check-equal? ((☯ (#%deforestable foldl (+) (0))) (list 1 2 3)) 6) + (check-equal? ((☯ (#%deforestable foldr (+) (0))) (list 1 2 3)) 6) + (check-equal? ((☯ (#%deforestable range () (3)))) (list 0 1 2)) + (check-equal? ((☯ (#%deforestable range () (0 3)))) (list 0 1 2)) + (check-equal? ((☯ (#%deforestable range () (0 5 2)))) (list 0 2 4)) + (check-equal? ((☯ (#%deforestable take () (2))) (list 1 2 3)) (list 1 2))) (test-suite "elementary boolean gates" (test-suite From 03cc55cd5857bc069b14be253b3466b1383246ce Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 2 Aug 2024 16:21:29 -0700 Subject: [PATCH 047/108] Compile higher-order `floe` positions in deforestation pass As the deforestation pass generates escaped Racket, we need to compile any higher-order `floe` positions in the fusable list operations at this stage, since the regular code generation step at the end of compilation would not operate on these resultant escaped expressions. --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 20 +++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 707db6c1c..fa709f0eb 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -80,19 +80,21 @@ #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter) - (pattern (#%deforestable filter (f)))) - + (pattern (#%deforestable filter (f-uncompiled)) + #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (map) - (pattern (#%deforestable map (f)))) + (pattern (#%deforestable map (f-uncompiled)) + #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-filter-map #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter-map) - (pattern (#%deforestable filter-map (f)))) + (pattern (#%deforestable filter-map (f-uncompiled)) + #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-take #:attributes (n) @@ -124,8 +126,9 @@ #:datum-literals (foldr) (pattern (#%deforestable foldr - (op) - ((#%host-expression init))))) + (op-uncompiled) + ((#%host-expression init))) + #:attr op (run-passes #'op-uncompiled))) (define-syntax-class fsc-foldl #:attributes (op init) @@ -133,8 +136,9 @@ #:datum-literals (foldl) (pattern (#%deforestable foldl - (op) - ((#%host-expression init))))) + (op-uncompiled) + ((#%host-expression init))) + #:attr op (run-passes #'op-uncompiled))) (define-syntax-class cad*r-datum #:attributes (countdown) From 50974c1b23c68d7f897547c4a8b621e42301b414 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 12:33:40 -0700 Subject: [PATCH 048/108] Surface tests for `qi/list` forms --- qi-test/tests/list.rkt | 186 +++++++++++++++++++++++++++++++++++++++++ qi-test/tests/qi.rkt | 6 +- 2 files changed, 190 insertions(+), 2 deletions(-) create mode 100644 qi-test/tests/list.rkt diff --git a/qi-test/tests/list.rkt b/qi-test/tests/list.rkt new file mode 100644 index 000000000..153573682 --- /dev/null +++ b/qi-test/tests/list.rkt @@ -0,0 +1,186 @@ +#lang racket/base + +(provide tests) + +(require qi + qi/list + rackunit + rackunit/text-ui + (only-in racket/function thunk) + (only-in math sqr)) + +(define tests + (test-suite + "qi/list tests" + + (test-suite + "basic" + (test-suite + "range" + (test-equal? "single arg" + ((☯ (range 3))) + (list 0 1 2)) + (test-equal? "two args" + ((☯ (range 1 4))) + (list 1 2 3)) + (test-equal? "three args" + ((☯ (range 1 6 2))) + (list 1 3 5))) + (test-suite + "filter" + (test-equal? "simple list" + ((☯ (filter odd?)) + (list 1 2 3)) + (list 1 3)) + (test-equal? "empty list" + ((☯ (filter odd?)) + null) + null) + (test-equal? "no matching values" + ((☯ (filter odd?)) + (list 2 4 6)) + null) + (test-equal? "all matching values" + ((☯ (filter odd?)) + (list 1 3 5)) + (list 1 3 5))) + (test-suite + "map" + (test-equal? "simple list" + ((☯ (map sqr)) + (list 1 2 3)) + (list 1 4 9)) + (test-equal? "empty list" + ((☯ (map sqr)) + null) + null)) + (test-suite + "foldl" + (test-equal? "simple list" + ((☯ (foldl + 0)) + (list 1 2 3)) + 6) + (test-equal? "empty list" + ((☯ (foldl + 0)) + null) + 0) + (test-equal? "non-commutative operation" + ((☯ (foldl string-append "")) + (list "a" "b" "c")) + "cba")) + (test-suite + "foldr" + (test-equal? "simple list" + ((☯ (foldr + 0)) + (list 1 2 3)) + 6) + (test-equal? "empty list" + ((☯ (foldr + 0)) + null) + 0) + (test-equal? "non-commutative operation" + ((☯ (foldr string-append "")) + (list "a" "b" "c")) + "abc")) + (test-suite + "car" + (test-equal? "simple list" + ((☯ car) + (list 1 2 3)) + 1) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ car) + null))) + (test-equal? "non-commutative operation" + ((☯ (foldr string-append "")) + (list "a" "b" "c")) + "abc")) + (test-suite + "null?" + (test-false "simple list" + ((☯ null?) + (list 1 2 3))) + (test-true "empty list" + ((☯ null?) + null))) + (test-suite + "empty?" + (test-false "simple list" + ((☯ empty?) + (list 1 2 3))) + (test-true "empty list" + ((☯ empty?) + null))) + (test-suite + "length" + (test-equal? "simple list" + ((☯ length) + (list 1 2 3)) + 3) + (test-equal? "empty list" + ((☯ length) + null) + 0)) + (test-suite + "filter-map" + (test-equal? "simple list" + ((☯ (filter-map (if positive? sqr #false))) + (list 1 -2 3)) + (list 1 9)) + (test-equal? "empty list" + ((☯ (filter-map (if positive? sqr #false))) + null) + null)) + (test-suite + "take" + (test-equal? "simple list" + ((☯ (take 2)) + (list 1 2 3)) + (list 1 2)) + (test-equal? "take none" + ((☯ (take 0)) + (list 1 2 3)) + null) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ (take 2)) + null))) + (test-equal? "take none from empty list" + ((☯ (take 0)) + null) + null)) + (test-suite + "cadr" + (test-equal? "simple list" + ((☯ cadr) + (list 1 2 3)) + 2) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ cadr) + null)))) + (test-suite + "caddr" + (test-equal? "simple list" + ((☯ caddr) + (list 1 2 3)) + 3) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ caddr) + null)))) + (test-suite + "caddr" + (test-equal? "simple list" + ((☯ cadddr) + (list 1 2 3 4)) + 4) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ cadddr) + null))))))) + +(module+ main + (void + (run-tests tests))) diff --git a/qi-test/tests/qi.rkt b/qi-test/tests/qi.rkt index 7edbec6b0..5cbae34e6 100644 --- a/qi-test/tests/qi.rkt +++ b/qi-test/tests/qi.rkt @@ -11,7 +11,8 @@ (prefix-in macro: "macro.rkt") (prefix-in util: "util.rkt") (prefix-in expander: "expander.rkt") - (prefix-in compiler: "compiler.rkt")) + (prefix-in compiler: "compiler.rkt") + (prefix-in list: "list.rkt")) (define tests (test-suite @@ -26,7 +27,8 @@ macro:tests util:tests expander:tests - compiler:tests)) + compiler:tests + list:tests)) (module+ test (void From e1171465d45fa393e33a433e080d8892eb78e9b5 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 15:35:47 -0700 Subject: [PATCH 049/108] Incorporate deforestation semantics tests into surface qi/list tests Now that these semantics tests are simply testing the behavior of newly defined Qi forms rather than ensuring low level rewriting of host language syntax, they can have ordinary unit tests validating their semantics, just like any other built-in Qi macros. --- qi-test/tests/compiler.rkt | 2 - qi-test/tests/compiler/semantics.rkt | 241 --------------- qi-test/tests/list.rkt | 424 +++++++++++++++++---------- 3 files changed, 268 insertions(+), 399 deletions(-) delete mode 100644 qi-test/tests/compiler/semantics.rkt diff --git a/qi-test/tests/compiler.rkt b/qi-test/tests/compiler.rkt index a132f4f92..0c2e7f8de 100644 --- a/qi-test/tests/compiler.rkt +++ b/qi-test/tests/compiler.rkt @@ -4,7 +4,6 @@ (require rackunit rackunit/text-ui - (prefix-in semantics: "compiler/semantics.rkt") (prefix-in rules: "compiler/rules.rkt") (prefix-in strategy: "compiler/strategy.rkt") (prefix-in impl: "compiler/impl.rkt")) @@ -13,7 +12,6 @@ (test-suite "compiler tests" - semantics:tests rules:tests strategy:tests impl:tests)) diff --git a/qi-test/tests/compiler/semantics.rkt b/qi-test/tests/compiler/semantics.rkt deleted file mode 100644 index 6d5172112..000000000 --- a/qi-test/tests/compiler/semantics.rkt +++ /dev/null @@ -1,241 +0,0 @@ -#lang racket/base - -(provide tests) - -(require qi - rackunit - rackunit/text-ui - (only-in math sqr) - qi/list - syntax/macro-testing - racket/string - racket/function) - -(define tests - (test-suite - "Compiler preserves semantics" - - (test-suite - "deforestation" - - (test-suite - "general" - (check-equal? ((☯ (~>> (filter odd?) (map sqr))) - (list 1 2 3 4 5)) - (list 1 9 25)) - (check-equal? ((☯ (~>> values (filter odd?) (map sqr) values)) - (list 1 2 3 4 5)) - (list 1 9 25) - "optimizes subexpressions") - (check-equal? ((☯ (~>> (filter odd?) (map sqr) (foldr + 0))) - (list 1 2 3 4 5)) - 35) - (check-equal? ((☯ (~>> (filter odd?) (map sqr) (foldl + 0))) - (list 1 2 3 4 5)) - 35) - (check-equal? ((☯ (~>> (map string-upcase) (foldr string-append "I"))) - (list "a" "b" "c")) - "ABCI") - (check-equal? ((☯ (~>> (map string-upcase) (foldl string-append "I"))) - (list "a" "b" "c")) - "CBAI") - (check-equal? ((☯ (~>> (range 10) (map sqr) car))) - 0)) - - (test-suite - "error reporting" - (test-exn "deforestation syntax phase - too many arguments for range producer (blanket)" - exn? - (lambda () - (convert-compile-time-error - ((flow (~>> (range 1 2 3 4 5) (filter odd?) (map sqr))))))) - - (test-exn "deforestation syntax phase - too many arguments for range producer (fine)" - exn? - (lambda () - (convert-compile-time-error - ((flow (~>> (range 1 2 3 4 5 _) (filter odd?) (map sqr))))))) - - (test-equal? "deforestation list->cstream-next usage" - ((flow (~>> (filter odd?) (map sqr))) - '(0 1 2 3 4 5 6 7 8 9)) - '(1 9 25 49 81)) - - ;; (test-exn "deforestation range->cstream-next - too few arguments at runtime" - ;; exn? - ;; (lambda () - ;; ((flow (~>> range (filter odd?) (map sqr)))))) - - ;; (test-exn "deforestation range->cstream-next - too many arguments at runtime" - ;; exn? - ;; (lambda () - ;; ((flow (~>> range (filter odd?) (map sqr))) 1 2 3 4))) - - (test-exn "deforestation car-cstream-next - empty list" - exn? - (lambda () - ((flow (~>> (filter odd?) (map sqr) car)) '())))) - - ;; (test-suite - ;; "range (stream producer)" - ;; ;; Semantic tests of the range producer that cover all combinations: - ;; (test-equal? "~>>range [1-3] (10)" - ;; (~>> (10) range (filter odd?) (map sqr)) - ;; '(1 9 25 49 81)) - ;; (test-equal? "~>range [1-3] (10)" - ;; (~> (10) range (~>> (filter odd?) (map sqr))) - ;; '(1 9 25 49 81)) - ;; (test-equal? "~>> range [1-3] (5 10)" - ;; (~>> (5 10) range (filter odd?) (map sqr)) - ;; '(25 49 81)) - ;; (test-equal? "~> range [1-3] (5 10)" - ;; (~> (5 10) range (~>> (filter odd?) (map sqr))) - ;; '(25 49 81)) - ;; (test-equal? "~>> range [1-3] (5 10 3)" - ;; (~>> (5 10 3) range (filter odd?) (map sqr)) - ;; '(25)) - ;; (test-equal? "~> range [1-3] (5 10 3)" - ;; (~> (5 10 3) range (~>> (filter odd?) (map sqr))) - ;; '(25)) - - ;; (test-equal? "~>> (range 10) [0-2] ()" - ;; (~>> () (range 10) (filter odd?) (map sqr)) - ;; '(1 9 25 49 81)) - ;; (test-equal? "~> (range 10) [0-2] ()" - ;; (~> () (range 10) (~>> (filter odd?) (map sqr))) - ;; '(1 9 25 49 81)) - ;; (test-equal? "~>> (range 5) [0-2] (10)" - ;; (~>> (10) (range 5) (filter odd?) (map sqr)) - ;; '(25 49 81)) - ;; (test-equal? "~> (range 10) [0-2] (5)" - ;; (~> (5) (range 10) (~>> (filter odd?) (map sqr))) - ;; '(25 49 81)) - ;; (test-equal? "~>> (range 3) [0-2] (5 10)" - ;; (~>> (3) (range 5 10) (filter odd?) (map sqr)) - ;; '(25)) - ;; (test-equal? "~> (range 5) [0-2] (10 3)" - ;; (~> (5) (range 10 3) (~>> (filter odd?) (map sqr))) - ;; '(25)) - - ;; (test-equal? "~>> (range 5 10) [0-1] ()" - ;; (~>> () (range 5 10) (filter odd?) (map sqr)) - ;; '(25 49 81)) - ;; (test-equal? "~> (range 5 10) [0-1] ()" - ;; (~> () (range 5 10) (~>> (filter odd?) (map sqr))) - ;; '(25 49 81)) - ;; (test-equal? "~>> (range 5 10) [0-1] (3)" - ;; (~>> (3) (range 5 10) (filter odd?) (map sqr)) - ;; '(25)) - ;; (test-equal? "~> (range 10 3) [0-1] (5)" - ;; (~> (5) (range 10 3) (~>> (filter odd?) (map sqr))) - ;; '(25)) - - ;; (test-equal? "~>> (range 5 10 3) [0] ()" - ;; (~>> () (range 5 10 3) (filter odd?) (map sqr)) - ;; '(25)) - - ;; (test-equal? "~>> (range _) [1] (10)" - ;; (~>> (10) (range _) (filter odd?) (map sqr)) - ;; '(1 9 25 49 81)) - ;; (test-equal? "~>> (range _ _) [2] (5 10)" - ;; (~>> (5 10) (range _ _) (filter odd?) (map sqr)) - ;; '(25 49 81)) - ;; (test-equal? "~>> (range _ _ _) [3] (5 10 3)" - ;; (~>> (5 10 3) (range _ _ _) (filter odd?) (map sqr)) - ;; '(25)) - - ;; (test-equal? "~>> (range 5 _) [1] (10)" - ;; (~>> (10) (range 5 _) (filter odd?) (map sqr)) - ;; '(25 49 81)) - ;; (test-equal? "~>> (range _ 10) [1] (5)" - ;; (~>> (5) (range _ 10) (filter odd?) (map sqr)) - ;; '(25 49 81)) - - ;; (test-equal? "~>> (range 5 _ _) [2] (10 3)" - ;; (~>> (10 3) (range 5 _ _) (filter odd?) (map sqr)) - ;; '(25)) - ;; (test-equal? "~>> (range _ 10 _) [2] (5 3)" - ;; (~>> (5 3) (range _ 10 _) (filter odd?) (map sqr)) - ;; '(25)) - ;; (test-equal? "~>> (range _ _ 3) [2] (5 10)" - ;; (~>> (5 10) (range _ _ 3) (filter odd?) (map sqr)) - ;; '(25)) - - ;; (test-equal? "~>> (range 5 10 _) [1] (3)" - ;; (~>> (3) (range 5 10 _) (filter odd?) (map sqr)) - ;; '(25)) - ;; (test-equal? "~>> (range 5 _ 3) [1] (10)" - ;; (~>> (10) (range 5 _ 3) (filter odd?) (map sqr)) - ;; '(25)) - ;; (test-equal? "~>> (range _ 10 3) [1] (5)" - ;; (~>> (5) (range _ 10 3) (filter odd?) (map sqr)) - ;; '(25))) - - (test-suite - "range" - (test-equal? "range" - (~> () (range 10) (filter odd?)) - '(1 3 5 7 9))) - (test-suite - "filter" - (test-equal? "filter" - (~> () (range 10) (filter odd?)) - '(1 3 5 7 9))) - (test-suite - "map" - (test-equal? "map" - (~> () (range 4) (map sqr)) - '(0 1 4 9))) - (test-suite - "filter-map" - (test-equal? "filter-map" - (~> () (range 4) (filter-map sqr)) - '(0 1 4 9))) - (test-suite - "foldl" - (test-equal? "foldl" - (~> ((list "a" "b" "c")) (filter non-empty-string?) (foldl string-append "")) - "cba")) - (test-suite - "foldr" - (test-equal? "foldr" - (~> ((list "a" "b" "c")) (filter non-empty-string?) (foldr string-append "")) - "abc")) - (test-suite - "list-ref" - (test-equal? "car" - (~> () (range 10) car) - 0) - (test-equal? "list-ref" - (~> () (range 10) (list-ref 2)) - 2)) - (test-suite - "length" - (test-equal? "length" - (~> () (range 10) length) - 10)) - (test-suite - "empty?" - (test-false "empty?" - (~> () (range 10) empty?)) - (test-true "empty?" - (~> () (range 0) empty?)) - (test-false "null?" - (~> () (range 10) null?)) - (test-true "null?" - (~> () (range 0) null?))) - - (test-suite - "take (stateful transformer)" - (test-equal? "take after filter" - (~>> () (range 20) (filter odd?) (take 5) (map sqr)) - '(1 9 25 49 81)) - - (test-equal? "two takes after filter" - (~>> () (range 20) (filter odd?) (take 5) (take 3) (map sqr)) - '(1 9 25)) - - )))) - -(module+ main - (void (run-tests tests))) diff --git a/qi-test/tests/list.rkt b/qi-test/tests/list.rkt index 153573682..d5d10d97d 100644 --- a/qi-test/tests/list.rkt +++ b/qi-test/tests/list.rkt @@ -7,6 +7,7 @@ rackunit rackunit/text-ui (only-in racket/function thunk) + (only-in racket/string non-empty-string?) (only-in math sqr)) (define tests @@ -15,171 +16,282 @@ (test-suite "basic" + (test-suite - "range" - (test-equal? "single arg" - ((☯ (range 3))) - (list 0 1 2)) - (test-equal? "two args" - ((☯ (range 1 4))) - (list 1 2 3)) - (test-equal? "three args" - ((☯ (range 1 6 2))) - (list 1 3 5))) - (test-suite - "filter" - (test-equal? "simple list" - ((☯ (filter odd?)) + "stream producers" + (test-suite + "range" + (test-equal? "single arg" + ((☯ (range 3))) + (list 0 1 2)) + (test-equal? "two args" + ((☯ (range 1 4))) (list 1 2 3)) - (list 1 3)) - (test-equal? "empty list" - ((☯ (filter odd?)) - null) - null) - (test-equal? "no matching values" - ((☯ (filter odd?)) - (list 2 4 6)) - null) - (test-equal? "all matching values" - ((☯ (filter odd?)) - (list 1 3 5)) - (list 1 3 5))) + (test-equal? "three args" + ((☯ (range 1 6 2))) + (list 1 3 5)))) + (test-suite - "map" - (test-equal? "simple list" - ((☯ (map sqr)) - (list 1 2 3)) - (list 1 4 9)) - (test-equal? "empty list" - ((☯ (map sqr)) + "stream transformers" + (test-suite + "filter" + (test-equal? "simple list" + ((☯ (filter odd?)) + (list 1 2 3)) + (list 1 3)) + (test-equal? "empty list" + ((☯ (filter odd?)) + null) null) - null)) - (test-suite - "foldl" - (test-equal? "simple list" - ((☯ (foldl + 0)) - (list 1 2 3)) - 6) - (test-equal? "empty list" - ((☯ (foldl + 0)) + (test-equal? "no matching values" + ((☯ (filter odd?)) + (list 2 4 6)) null) - 0) - (test-equal? "non-commutative operation" - ((☯ (foldl string-append "")) - (list "a" "b" "c")) - "cba")) - (test-suite - "foldr" - (test-equal? "simple list" - ((☯ (foldr + 0)) - (list 1 2 3)) - 6) - (test-equal? "empty list" - ((☯ (foldr + 0)) + (test-equal? "all matching values" + ((☯ (filter odd?)) + (list 1 3 5)) + (list 1 3 5))) + (test-suite + "map" + (test-equal? "simple list" + ((☯ (map sqr)) + (list 1 2 3)) + (list 1 4 9)) + (test-equal? "empty list" + ((☯ (map sqr)) + null) + null)) + (test-suite + "filter-map" + (test-equal? "simple list" + ((☯ (filter-map (if positive? sqr #false))) + (list 1 -2 3)) + (list 1 9)) + (test-equal? "empty list" + ((☯ (filter-map (if positive? sqr #false))) + null) + null)) + (test-suite + "take (stateful transformer)" + (test-equal? "simple list" + ((☯ (take 2)) + (list 1 2 3)) + (list 1 2)) + (test-equal? "take none" + ((☯ (take 0)) + (list 1 2 3)) null) - 0) - (test-equal? "non-commutative operation" - ((☯ (foldr string-append "")) - (list "a" "b" "c")) - "abc")) - (test-suite - "car" - (test-equal? "simple list" - ((☯ car) - (list 1 2 3)) - 1) - (test-exn "empty list" - exn:fail:contract? - (thunk ((☯ car) - null))) - (test-equal? "non-commutative operation" - ((☯ (foldr string-append "")) - (list "a" "b" "c")) - "abc")) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ (take 2)) + null))) + (test-equal? "take none from empty list" + ((☯ (take 0)) + null) + null))) + (test-suite - "null?" - (test-false "simple list" + "stream consumers" + (test-suite + "foldl" + (test-equal? "simple list" + ((☯ (foldl + 0)) + (list 1 2 3)) + 6) + (test-equal? "empty list" + ((☯ (foldl + 0)) + null) + 0) + (test-equal? "non-commutative operation" + ((☯ (foldl string-append "")) + (list "a" "b" "c")) + "cba")) + (test-suite + "foldr" + (test-equal? "simple list" + ((☯ (foldr + 0)) + (list 1 2 3)) + 6) + (test-equal? "empty list" + ((☯ (foldr + 0)) + null) + 0) + (test-equal? "non-commutative operation" + ((☯ (foldr string-append "")) + (list "a" "b" "c")) + "abc")) + (test-suite + "car" + (test-equal? "simple list" + ((☯ car) + (list 1 2 3)) + 1) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ car) + null))) + (test-equal? "non-commutative operation" + ((☯ (foldr string-append "")) + (list "a" "b" "c")) + "abc")) + (test-suite + "null?" + (test-false "simple list" + ((☯ null?) + (list 1 2 3))) + (test-true "empty list" ((☯ null?) - (list 1 2 3))) - (test-true "empty list" - ((☯ null?) - null))) - (test-suite - "empty?" - (test-false "simple list" + null))) + (test-suite + "empty?" + (test-false "simple list" + ((☯ empty?) + (list 1 2 3))) + (test-true "empty list" ((☯ empty?) - (list 1 2 3))) - (test-true "empty list" - ((☯ empty?) - null))) - (test-suite - "length" - (test-equal? "simple list" - ((☯ length) - (list 1 2 3)) - 3) - (test-equal? "empty list" - ((☯ length) - null) - 0)) - (test-suite - "filter-map" - (test-equal? "simple list" - ((☯ (filter-map (if positive? sqr #false))) - (list 1 -2 3)) - (list 1 9)) - (test-equal? "empty list" - ((☯ (filter-map (if positive? sqr #false))) - null) - null)) - (test-suite - "take" - (test-equal? "simple list" - ((☯ (take 2)) - (list 1 2 3)) - (list 1 2)) - (test-equal? "take none" - ((☯ (take 0)) - (list 1 2 3)) - null) - (test-exn "empty list" - exn:fail:contract? - (thunk ((☯ (take 2)) - null))) - (test-equal? "take none from empty list" - ((☯ (take 0)) - null) - null)) - (test-suite - "cadr" - (test-equal? "simple list" - ((☯ cadr) - (list 1 2 3)) - 2) - (test-exn "empty list" - exn:fail:contract? - (thunk ((☯ cadr) - null)))) - (test-suite - "caddr" - (test-equal? "simple list" - ((☯ caddr) - (list 1 2 3)) - 3) - (test-exn "empty list" - exn:fail:contract? - (thunk ((☯ caddr) - null)))) - (test-suite - "caddr" - (test-equal? "simple list" - ((☯ cadddr) - (list 1 2 3 4)) - 4) - (test-exn "empty list" - exn:fail:contract? - (thunk ((☯ cadddr) - null))))))) + null))) + (test-suite + "length" + (test-equal? "simple list" + ((☯ length) + (list 1 2 3)) + 3) + (test-equal? "empty list" + ((☯ length) + null) + 0)) + (test-suite + "cadr" + (test-equal? "simple list" + ((☯ cadr) + (list 1 2 3)) + 2) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ cadr) + null)))) + (test-suite + "caddr" + (test-equal? "simple list" + ((☯ caddr) + (list 1 2 3)) + 3) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ caddr) + null)))) + (test-suite + "cadddr" + (test-equal? "simple list" + ((☯ cadddr) + (list 1 2 3 4)) + 4) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ cadddr) + null)))))) + + (test-suite + "combinations" + + (test-equal? "filter..map" + ((☯ (~> (filter odd?) + (map sqr))) + (list 1 2 3)) + (list 1 9)) + (test-equal? "filter..car" + ((☯ (~> (filter odd?) + car)) + (list 1 2 3)) + 1) + (test-equal? "filter..foldl" + ((☯ (~> (filter odd?) + (foldl + 0))) + (list 1 2 3)) + 4) + (test-equal? "filter..foldr" + ((☯ (~> (filter odd?) + (foldr + 0))) + (list 1 2 3)) + 4) + (test-equal? "filter..foldl with non-commutative operation" + ((☯ (~> (filter non-empty-string?) + (foldl string-append ""))) + (list "a" "b" "c")) + "cba") + (test-equal? "filter..foldr with non-commutative operation" + ((☯ (~> (filter non-empty-string?) + (foldr string-append ""))) + (list "a" "b" "c")) + "abc") + (test-equal? "map..foldl" + ((☯ (~> (map string-upcase) + (foldl string-append "I"))) + (list "a" "b" "c")) + "CBAI") + (test-equal? "map..foldr" + ((☯ (~> (map string-upcase) + (foldr string-append "I"))) + (list "a" "b" "c")) + "ABCI") + (test-equal? "range..car" + ((☯ (~> (range 10) + car))) + 0) + (test-equal? "range..map" + ((☯ (~> (range 3) + (map sqr)))) + (list 0 1 4)) + (test-equal? "range..filter..car" + ((☯ (~> (range 1 4) + (filter odd?) + car))) + 1) + (test-equal? "range..map..car" + ((☯ (~> (range 10) + (map sqr) + car))) + 0) + (test-equal? "filter..map..foldr" + ((☯ (~> (filter odd?) + (map sqr) + (foldr + 0))) + (list 1 2 3 4 5)) + 35) + (test-equal? "filter..map..foldl" + ((☯ (~> (filter odd?) + (map sqr) + (foldl + 0))) + (list 1 2 3 4 5)) + 35) + (test-equal? "range..filter..map" + ((☯ (~> (range 10) + (filter odd?) + (map sqr)))) + '(1 9 25 49 81)) + (test-equal? "range..filter..map with right threading" + ((☯ (~>> (range 10) + (filter odd?) + (map sqr)))) + '(1 9 25 49 81)) + (test-equal? "range..filter..map with different nested threading direction" + ((☯ (~> (range 10) + (~>> (filter odd?) + (map sqr))))) + '(1 9 25 49 81)) + (test-equal? "take after filter" + ((☯ (~> (range 20) + (filter odd?) + (take 5) + (map sqr)))) + '(1 9 25 49 81)) + (test-equal? "two takes after filter" + ((☯ (~> (range 20) + (filter odd?) + (take 5) + (take 3) + (map sqr)))) + '(1 9 25))))) (module+ main (void From 81184e7c085b94bba1661f433151977d1ab84e29 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 16:14:59 -0700 Subject: [PATCH 050/108] remove copypasta test --- qi-test/tests/list.rkt | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/qi-test/tests/list.rkt b/qi-test/tests/list.rkt index d5d10d97d..157279258 100644 --- a/qi-test/tests/list.rkt +++ b/qi-test/tests/list.rkt @@ -129,11 +129,7 @@ (test-exn "empty list" exn:fail:contract? (thunk ((☯ car) - null))) - (test-equal? "non-commutative operation" - ((☯ (foldr string-append "")) - (list "a" "b" "c")) - "abc")) + null)))) (test-suite "null?" (test-false "simple list" From 3360d426bddf1aae38714fa04eed65469951aaca Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 16:15:25 -0700 Subject: [PATCH 051/108] Test list forms using higher-order Qi syntax --- qi-test/tests/list.rkt | 30 ++++++++++++++++++++++++++---- 1 file changed, 26 insertions(+), 4 deletions(-) diff --git a/qi-test/tests/list.rkt b/qi-test/tests/list.rkt index 157279258..d000de0f0 100644 --- a/qi-test/tests/list.rkt +++ b/qi-test/tests/list.rkt @@ -50,7 +50,11 @@ (test-equal? "all matching values" ((☯ (filter odd?)) (list 1 3 5)) - (list 1 3 5))) + (list 1 3 5)) + (test-equal? "filter with higher-order Qi syntax" + ((☯ (filter (and positive? integer?))) + (list 1 -2 3 0.2 4)) + (list 1 3 4))) (test-suite "map" (test-equal? "simple list" @@ -60,7 +64,11 @@ (test-equal? "empty list" ((☯ (map sqr)) null) - null)) + null) + (test-equal? "map with higher-order Qi syntax" + ((☯ (map (~> sqr add1))) + (list 1 2 3)) + (list 2 5 10))) (test-suite "filter-map" (test-equal? "simple list" @@ -105,7 +113,14 @@ (test-equal? "non-commutative operation" ((☯ (foldl string-append "")) (list "a" "b" "c")) - "cba")) + "cba") + (test-equal? "foldl with higher-order Qi syntax" + ((☯ (foldl (~> (>< number->string) + string-append + string->number) + 0)) + (list 1 2 3)) + 3210)) (test-suite "foldr" (test-equal? "simple list" @@ -119,7 +134,14 @@ (test-equal? "non-commutative operation" ((☯ (foldr string-append "")) (list "a" "b" "c")) - "abc")) + "abc") + (test-equal? "foldr with higher-order Qi syntax" + ((☯ (foldr (~> (>< number->string) + string-append + string->number) + 0)) + (list 1 2 3)) + 1230)) (test-suite "car" (test-equal? "simple list" From f7d5e30edb8d398487d4254dcf9d5d884258a4fa Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 16:31:40 -0700 Subject: [PATCH 052/108] Remove unused module providing bindings for deforestation We now deforest via the `#%deforestable` core form and don't need host language (yet provided by Qi) bindings for this purpose anymore. --- qi-lib/flow/core/compiler/1000-qi0.rkt | 4 +-- .../flow/core/compiler/deforest/bindings.rkt | 35 ------------------- qi-lib/flow/core/compiler/deforest/syntax.rkt | 3 +- 3 files changed, 2 insertions(+), 40 deletions(-) delete mode 100644 qi-lib/flow/core/compiler/deforest/bindings.rkt diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 20ca0de9d..de644c2b7 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -4,9 +4,7 @@ (prefix-in fancy: fancy-app) "../impl.rkt" racket/function - "deforest/bindings.rkt" - (only-in racket/list - make-list) + racket/list (for-syntax racket/base syntax/parse "../syntax.rkt" diff --git a/qi-lib/flow/core/compiler/deforest/bindings.rkt b/qi-lib/flow/core/compiler/deforest/bindings.rkt deleted file mode 100644 index 22eccb9a7..000000000 --- a/qi-lib/flow/core/compiler/deforest/bindings.rkt +++ /dev/null @@ -1,35 +0,0 @@ -#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/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index fa709f0eb..405c81578 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -28,8 +28,7 @@ (for-template racket/base "../../passes.rkt" "../../strategy.rkt" - "templates.rkt" - (prefix-in qi: "bindings.rkt")) + "templates.rkt") (for-syntax racket/base syntax/parse)) From 7f87f94d098e4069113e0928093e6f32c47a8772 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 16:33:20 -0700 Subject: [PATCH 053/108] Fix syntax error in benchmarks Use Qi equivalents as lambda is no longer valid in this position (at least until/unless #177 is merged). --- qi-sdk/benchmarks/nonlocal/qi/main.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qi-sdk/benchmarks/nonlocal/qi/main.rkt b/qi-sdk/benchmarks/nonlocal/qi/main.rkt index b32fb662c..8bf6ad414 100644 --- a/qi-sdk/benchmarks/nonlocal/qi/main.rkt +++ b/qi-sdk/benchmarks/nonlocal/qi/main.rkt @@ -95,8 +95,8 @@ (filter odd?) (map sqr) values - (filter (λ (v) (< (remainder v 10) 5))) - (map (λ (v) (* 2 v))) + (filter (~> (remainder 10) (< 5))) + (map (* 2)) (foldl + 0))) ;; (define filter-double From 617858aec0741c00e061598a2336026cb675f1bd Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 16:47:48 -0700 Subject: [PATCH 054/108] Remove Racket `range` import in benchmarks We use Qi's `range` now. Also, add a Makefile target to build the SDK to reproduce such build errors in future. --- Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Makefile b/Makefile index 9b1173efc..fd82677d3 100644 --- a/Makefile +++ b/Makefile @@ -98,6 +98,9 @@ build-all: build-standalone-docs: scribble +m --redirect-main http://pkg-build.racket-lang.org/doc/ --htmls --dest ./docs ./qi-doc/scribblings/qi.scrbl +build-sdk: + raco setup --no-docs --pkgs $(PACKAGE-NAME)-sdk + # Note: Each collection's info.rkt can say what to clean, for example # (define clean '("compiled" "doc" "doc/")) to clean # generated docs, too. From 81c9f5d492a1ea25ac11dad2ca7783594bec48bf Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 17:22:25 -0700 Subject: [PATCH 055/108] test the expansion of `#%deforestable` --- qi-test/tests/expander.rkt | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/qi-test/tests/expander.rkt b/qi-test/tests/expander.rkt index 07e556920..76b99c3de 100644 --- a/qi-test/tests/expander.rkt +++ b/qi-test/tests/expander.rkt @@ -103,7 +103,12 @@ #'(thread (#%blanket-template ((#%host-expression f) (#%host-expression 1) - __))))) + __)))) + (test-expand "#%deforestable" + #'(#%deforestable name (_) (_)) + #'(#%deforestable name + (_) + ((#%host-expression _))))) (test-suite "utils" ;; this is just temporary until we properly track source expressions through From b6d3a7f9e2a15d990e3e031caface06e60b218db Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 17:22:52 -0700 Subject: [PATCH 056/108] Test syntax error using `range` with no arguments --- qi-lib/list.rkt | 3 +++ qi-test/tests/list.rkt | 8 +++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 93b4b5759..0d96362d3 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -30,6 +30,9 @@ [(_ low:expr high:expr step:expr) #'(#%deforestable range () (low high step))] [(_ low:expr high:expr) #'(#%deforestable range () (low high 1))] [(_ high:expr) #'(#%deforestable range () (0 high 1))] + ;; not strictly necessary but this provides a better error + ;; message than simply "range: bad syntax" that's warranted + ;; to differentiate from racket/list's `range` [_:id (report-syntax-error this-syntax "(range arg ...)" "range expects at least one argument")]) diff --git a/qi-test/tests/list.rkt b/qi-test/tests/list.rkt index d000de0f0..7cb556a7e 100644 --- a/qi-test/tests/list.rkt +++ b/qi-test/tests/list.rkt @@ -6,6 +6,7 @@ qi/list rackunit rackunit/text-ui + syntax/macro-testing (only-in racket/function thunk) (only-in racket/string non-empty-string?) (only-in math sqr)) @@ -29,7 +30,12 @@ (list 1 2 3)) (test-equal? "three args" ((☯ (range 1 6 2))) - (list 1 3 5)))) + (list 1 3 5)) + (test-exn "expects at least one argument" + exn:fail:syntax? + (thunk + (convert-compile-time-error + ((☯ range))))))) (test-suite "stream transformers" From 1140870f4e1fc24a1b56471839531d5e77d31ce7 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 17:35:25 -0700 Subject: [PATCH 057/108] Tests for `list-ref` --- qi-test/tests/list.rkt | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/qi-test/tests/list.rkt b/qi-test/tests/list.rkt index 7cb556a7e..416df6b0f 100644 --- a/qi-test/tests/list.rkt +++ b/qi-test/tests/list.rkt @@ -184,6 +184,16 @@ ((☯ length) null) 0)) + (test-suite + "list-ref" + (test-equal? "simple list" + ((☯ (list-ref 1)) + (list 1 2 3)) + 2) + (test-exn "empty list" + exn:fail:contract? + (thunk ((☯ (list-ref 1)) + null)))) (test-suite "cadr" (test-equal? "simple list" From f439d089617da493dfa3bcfaf6744fe2d9ff88ce Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 18:25:58 -0700 Subject: [PATCH 058/108] Add a test for a syntax error utility Coverage was reporting this case uncovered --- qi-test/tests/util.rkt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/qi-test/tests/util.rkt b/qi-test/tests/util.rkt index 9e0510a9c..0a628efeb 100644 --- a/qi-test/tests/util.rkt +++ b/qi-test/tests/util.rkt @@ -18,7 +18,10 @@ "blah: blah" "Use it" "like" - "this")))))) + "this"))) + (check-exn exn:fail:syntax? + (thunk (report-syntax-error #'dummy + "blah: blah")))))) (module+ main (void (run-tests tests))) From eb5e3951f69559e9eacaddfc3d2d18930faf3975 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 22:27:27 -0700 Subject: [PATCH 059/108] Modify a `range` test to use syntax with an explicit bound argument In the provisional syntax of Qi's `range`, we expect the range to be specified syntactically, as it compiles to a lambda accepting no arguments. --- qi-test/tests/compiler/rules/deforest.rkt | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index 23da3656d..11d672834 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -72,14 +72,14 @@ ;; between the optimization being applied once vs twice. We would like it ;; to do so in order to validate and justify the need for fixed-point ;; finding in the deforestation pass. - ;; (test-deforested "multiple applications of deforestation to the same expression" - ;; #'(~>> (filter odd?) - ;; (map sqr) - ;; (foldr + 0) - ;; range - ;; (filter odd?) - ;; (map sqr))) - ) + (test-deforested "multiple applications of deforestation to the same expression" + #'(~> (filter odd?) + (map sqr) + (foldr + 0) + (as v) + (range v) + (filter odd?) + (map sqr)))) (test-suite "transformers" From 48cdb8eb9039a190ad7cbbd0185293c8daf7ddd3 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 22:49:44 -0700 Subject: [PATCH 060/108] Update deforestation rules tests - use left-threading in most tests - one test using right-threading to validate deforestation is invariant to threading direction - use `range` with syntactically specified arguments; remove tests using templates - consolidate `deforest-pass` tests since we no longer have a separate test suite for individual applications of the deforestation rewrite rule (should we?) --- qi-test/tests/compiler/rules/deforest.rkt | 158 ++++++++-------------- 1 file changed, 56 insertions(+), 102 deletions(-) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index 11d672834..c211ebcd5 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -50,23 +50,28 @@ (test-suite "deforest-pass" + (test-suite "general" (test-not-deforested "does not deforest single stream component in isolation" - #'(~>> (filter odd?))) + #'(~> (filter odd?))) (test-not-deforested "does not deforest map in the head position" - #'(~>> (map sqr) (filter odd?))) - (test-deforested "deforestation in arbitrary positions" + #'(~> (map sqr) (filter odd?))) + (test-deforested "deforestation is invariant to threading direction" #'(~>> values (filter odd?) (map sqr) values)) (test-deforested "deforestation in arbitrary positions" - #'(~>> - values - (filter string-upcase) - (foldl string-append "I") - values)) + #'(~> values + (filter odd?) + (map sqr) + values)) + (test-deforested "deforestation in arbitrary positions" + #'(~> values + (filter string-upcase) + (foldl string-append "I") + values)) ;; TODO: this test is for a case where deforestation should be applied twice ;; to the same expression. But currently, the test does not differentiate ;; between the optimization being applied once vs twice. We would like it @@ -79,173 +84,122 @@ (as v) (range v) (filter odd?) - (map sqr)))) + (map sqr))) + (test-true "nested positions" + (deforested? (phase1-eval + (deforest-pass + (expand-flow + #'(>< (~> (filter odd?) (map sqr)))))))) + (test-case "multiple independent positions" + (let ([stx (phase1-eval + (deforest-pass + (expand-flow + #'(-< (~> (filter odd?) (map sqr)) + (~> (as v) (range v) car)))))]) + (check-true (deforested? stx)) + (check-true (filter-deforested? stx)) + (check-true (list-ref-deforested? stx))))) (test-suite "transformers" (test-deforested "filter->map (two transformers)" - #'(~>> (filter odd?) (map sqr))) + #'(~> (filter odd?) (map sqr))) (test-suite "filter" (test-true "filter" (filter-deforested? (test-deforest - #'(~>> (filter odd?) (map sqr)))))) + #'(~> (filter odd?) (map sqr)))))) (test-suite "map" (test-true "map" (map-deforested? (test-deforest - #'(~>> (filter odd?) (map sqr)))))) + #'(~> (filter odd?) (map sqr)))))) (test-suite "filter-map" (test-true "filter-map" (filter-map-deforested? (test-deforest - #'(~>> (filter odd?) (filter-map sqr)))))) + #'(~> (filter odd?) (filter-map sqr)))))) (test-suite "take" (test-true "take" (take-deforested? (test-deforest - #'(~>> (filter odd?) (take 3))))))) + #'(~> (filter odd?) (take 3))))))) (test-suite "producers" (test-suite "range" - (test-deforested "range" - #'(~> (range 10) (filter odd?))) (test-true "range" (range-deforested? (test-deforest - #'(~> (range 10) (filter odd?)))))) - ;; (test-suite - ;; "range" - ;; ;; TODO: note that these uses of `range` are matched as datums - ;; ;; and requiring racket/list's range is not required in this module - ;; ;; for deforestation to happen. This should be changed to use - ;; ;; literal matching in the compiler. - ;; (test-deforested "range" - ;; #'(~>> range (filter odd?))) - ;; (test-deforested "(range _)" - ;; #'(~>> (range _) (filter odd?))) - ;; (test-deforested "(range _ _)" - ;; #'(~>> (range _ _) (filter odd?))) - ;; (test-deforested "(range 0 _)" - ;; #'(~>> (range 0 _) (filter odd?))) - ;; (test-deforested "(range _ 10)" - ;; #'(~>> (range _ 10) (filter odd?))) - ;; (test-deforested "(range _ _ _)" - ;; #'(~>> (range _ _ _) (filter odd?))) - ;; (test-deforested "(range _ _ 1)" - ;; #'(~>> (range _ _ 1) (filter odd?))) - ;; (test-deforested "(range _ 10 _)" - ;; #'(~>> (range _ 10 _) (filter odd?))) - ;; (test-deforested "(range _ 10 1)" - ;; #'(~>> (range _ 10 1) (filter odd?))) - ;; (test-deforested "(range 0 _ _)" - ;; #'(~>> (range 0 _ _) (filter odd?))) - ;; (test-deforested "(range 0 _ 1)" - ;; #'(~>> (range 0 _ 1) (filter odd?))) - ;; (test-deforested "(range 0 10 _)" - ;; #'(~>> (range 0 10 _) (filter odd? __))) - ;; (test-deforested "(range __)" - ;; #'(~>> (range __) (filter odd?))) - ;; (test-deforested "(range 0 __)" - ;; #'(~>> (range 0 __) (filter odd?))) - ;; (test-deforested "(range __ 1)" - ;; #'(~>> (range __ 1) (filter odd?))) - ;; (test-deforested "(range 0 10 __)" - ;; #'(~>> (range 0 10 __) (filter odd?))) - ;; (test-deforested "(range __ 10 1)" - ;; #'(~>> (range __ 10 1) (filter odd? __))) - ;; (test-deforested "(range 0 __ 1)" - ;; #'(~>> (range 0 __ 1) (filter odd?))) - ;; (test-deforested "(range 0 10 1 __)" - ;; #'(~>> (range 0 10 1 __) (filter odd?))) - ;; (test-deforested "(range 0 10 __ 1)" - ;; #'(~>> (range 0 10 __ 1) (filter odd?))) - ;; (test-deforested "(range 0 __ 10 1)" - ;; #'(~>> (range 0 __ 10 1) (filter odd?))) - ;; (test-deforested "(range __ 0 10 1)" - ;; #'(~>> (range __ 0 10 1) (filter odd?)))) - ) + #'(~> (range 10) (filter odd?))))) + (test-true "range" + (range-deforested? + (test-deforest + #'(~> (range 1 10) (filter odd?))))) + (test-true "range" + (range-deforested? + (test-deforest + #'(~> (range 1 10 2) (filter odd?))))))) (test-suite "consumers" (test-suite "list-ref" (test-deforested "car" - #'(~>> (filter odd?) car)) + #'(~> (filter odd?) car)) (test-true "car" (list-ref-deforested? (test-deforest - #'(~>> (filter odd?) car)))) + #'(~> (filter odd?) car)))) (test-deforested "list-ref" - #'(~>> (filter odd?) (list-ref 2))) + #'(~> (filter odd?) (list-ref 2))) (test-true "list-ref" (list-ref-deforested? (test-deforest - #'(~>> (filter odd?) (list-ref 2)))))) + #'(~> (filter odd?) (list-ref 2)))))) (test-suite "foldl" (test-deforested "foldl" - #'(~>> (filter non-empty-string?) (foldl string-append "I"))) + #'(~> (filter non-empty-string?) (foldl string-append "I"))) (test-true "foldl" (foldl-deforested? (test-deforest - #'(~>> (filter non-empty-string?) (foldl string-append "I")))))) + #'(~> (filter non-empty-string?) (foldl string-append "I")))))) (test-suite "foldr" (test-deforested "foldr" - #'(~>> (filter non-empty-string?) (foldr string-append "I"))) + #'(~> (filter non-empty-string?) (foldr string-append "I"))) (test-true "foldr" (foldr-deforested? (test-deforest - #'(~>> (filter non-empty-string?) (foldr string-append "I")))))) + #'(~> (filter non-empty-string?) (foldr string-append "I")))))) (test-suite "length" (test-deforested "length" - #'(~>> (filter non-empty-string?) length)) + #'(~> (filter non-empty-string?) length)) (test-true "length" (length-deforested? (test-deforest - #'(~>> (filter non-empty-string?) length))))) + #'(~> (filter non-empty-string?) length))))) (test-suite "empty?" (test-deforested "empty?" - #'(~>> (filter non-empty-string?) empty?)) + #'(~> (filter non-empty-string?) empty?)) (test-true "empty?" (empty?-deforested? (test-deforest - #'(~>> (filter non-empty-string?) empty?)))) + #'(~> (filter non-empty-string?) empty?)))) (test-deforested "null?" - #'(~>> (filter non-empty-string?) null?)) + #'(~> (filter non-empty-string?) null?)) (test-true "null?" (empty?-deforested? (test-deforest - #'(~>> (filter non-empty-string?) null?))))))) - - (test-suite - "deforest-pass" - (test-true "nested positions" - (deforested? (phase1-eval - (deforest-pass - (expand-flow - #'(>< (~>> (filter odd?) (map sqr)))))))) - ;; (let ([stx (phase1-eval - ;; (deforest-pass - ;; (expand-flow - ;; #'(-< (~>> (filter odd?) (map sqr)) - ;; (~>> range car)))))]) - ;; (test-true "multiple independent positions" - ;; (deforested? stx)) - ;; (test-true "multiple independent positions" - ;; (filter-deforested? stx)) - ;; (test-true "multiple independent positions" - ;; (list-ref-deforested? stx))) - ))) + #'(~> (filter non-empty-string?) null?))))))))) (module+ main (void From ecb5856ba34a4d64022ca4be83c8fd3dfd463331 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sun, 11 Aug 2024 13:11:31 -0700 Subject: [PATCH 061/108] Add a commented-out failing test for a case of desired deforestation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When a nested form has a different chirality (threading direction) than a containing form, normalization would not collapse them, but deforestation may not care about the difference. Possible approaches: A. Introduce normalization rules designed to detect when change of chirality is irrelevant. B. Look for patterns in the deforestation pass involving differing threading directions Probably (A) is the right approach, and we could introduce a set of chirality normalization rules that "trim" forms on either end of a nested form which could be collapsed into the containing form. This would include anything that isn't a host language function application (which is the only case where chirality matters). Actually, thinking again, chirality is already represented in the core language simply as the presence of a blanket template in a function application form, and nested threading is already collapsed by normalization, so, I'm not sure anymore why this test is failing ¯\_(ツ)_/¯ --- qi-test/tests/compiler/rules/deforest.rkt | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index c211ebcd5..9abc834b2 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -90,6 +90,15 @@ (deforest-pass (expand-flow #'(>< (~> (filter odd?) (map sqr)))))))) + ;; TODO: this test fails because normalization would not collapse + ;; forms with different threading directions, but in some cases + ;; (like this test), deforestation should not care about the chirality + ;; difference. + ;; (test-true "nested, different threading direction" + ;; (deforested? (phase1-eval + ;; (deforest-pass + ;; (expand-flow + ;; #'(~> (filter odd?) (~>> (map sqr)))))))) (test-case "multiple independent positions" (let ([stx (phase1-eval (deforest-pass From 14c41d936b29e2b8bf199f354451155c006717e1 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sun, 11 Aug 2024 13:34:53 -0700 Subject: [PATCH 062/108] refile the failing test (it now passes) --- qi-test/tests/compiler/rules/deforest.rkt | 19 ++++++++----------- qi-test/tests/compiler/rules/full-cycle.rkt | 13 ++++++++++++- 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt index 9abc834b2..6e67fe033 100644 --- a/qi-test/tests/compiler/rules/deforest.rkt +++ b/qi-test/tests/compiler/rules/deforest.rkt @@ -45,8 +45,14 @@ (test-suite "deforestation" ;; Note that these test deforestation in isolation - ;; without necessarily taking normalization (a preceding - ;; step in compilation) into account + ;; *without* taking normalization (a preceding + ;; step in compilation) into account. + ;; If a test is failing that you are expecting should pass, + ;; it could be that it implicitly assumes that normalization + ;; will be done, so double check this. + ;; For testing behavior of the full cycle of compilation + ;; involving normalization as well as deforestation, use the + ;; `full-cycle.rkt` test module. (test-suite "deforest-pass" @@ -90,15 +96,6 @@ (deforest-pass (expand-flow #'(>< (~> (filter odd?) (map sqr)))))))) - ;; TODO: this test fails because normalization would not collapse - ;; forms with different threading directions, but in some cases - ;; (like this test), deforestation should not care about the chirality - ;; difference. - ;; (test-true "nested, different threading direction" - ;; (deforested? (phase1-eval - ;; (deforest-pass - ;; (expand-flow - ;; #'(~> (filter odd?) (~>> (map sqr)))))))) (test-case "multiple independent positions" (let ([stx (phase1-eval (deforest-pass diff --git a/qi-test/tests/compiler/rules/full-cycle.rkt b/qi-test/tests/compiler/rules/full-cycle.rkt index d225d482d..4ef5f615f 100644 --- a/qi-test/tests/compiler/rules/full-cycle.rkt +++ b/qi-test/tests/compiler/rules/full-cycle.rkt @@ -33,7 +33,18 @@ (deforested? (phase1-eval (qi-compile - #'(~>> (filter odd?) values (map sqr))))))))) + #'(~>> (filter odd?) values (map sqr)))))) + ;; We expect the Qi expander to translate threading direction simply to + ;; chirality of individual contained forms (indicated by the presence of + ;; a blanket template on either side) if they are applications of host + ;; language functions, and to leave them unchanged if they are syntactic + ;; forms (where chirality is irrelevant). We also expect normalization + ;; to collapse nested threading forms, so that the following should be + ;; deforested. + (test-true "nested, different threading direction" + (deforested? (phase1-eval + (qi-compile + #'(~> (filter odd?) (~>> (map sqr)))))))))) (module+ main (void From 9d72acd9a9c701b19914f70164a284086c2f3234 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sat, 16 Nov 2024 13:01:34 -0700 Subject: [PATCH 063/108] Use `define-dsl-syntax` instead of `define-qi-syntax` `define-qi-syntax` was written before `define-dsl-syntax` existed, and it's better to use standard utilities from infrastructure libraries like `syntax-spec` where we can. (done in yesterday's Qi meeting) --- qi-lib/macro.rkt | 67 ++++++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 34 deletions(-) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index 7a0e84040..678063cbc 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -15,7 +15,8 @@ esc) qi/flow/space syntax/parse/define - syntax/parse) + syntax/parse + syntax-spec-v2) (begin-for-syntax @@ -62,50 +63,48 @@ (define (make-qi-foreign-syntax-transformer original-macro-id) (define/syntax-parse original-macro original-macro-id) - (qi-macro - (syntax-parser - [(name pre-form ... (~datum __) post-form ...) - (let ([name (syntax->datum #'name)]) - (raise-syntax-error name - (~a "Syntax error in " - `(,name - ,@(syntax->datum #'(pre-form ...)) - "__" - ,@(syntax->datum #'(post-form ...))) - "\n" - " __ templates are not supported for foreign macros.\n" - " Use _'s to indicate a specific number of expected arguments, instead.")))] - [(name pre-form ... (~datum _) post-form ...) - (foreign-macro-template-expand - (datum->syntax this-syntax - (cons #'original-macro - (cdr (syntax->list this-syntax)))))] - [(name form ...) - #:do [(define chirality (syntax-property this-syntax 'chirality))] - (if (and chirality (eq? chirality 'right)) - #'(esc (lambda (v) (original-macro form ... v))) - #'(esc (lambda (v) (original-macro v form ...))))] - [name:id #'(esc (lambda (v) (original-macro v)))])))) + (syntax-parser + [(name pre-form ... (~datum __) post-form ...) + (let ([name (syntax->datum #'name)]) + (raise-syntax-error name + (~a "Syntax error in " + `(,name + ,@(syntax->datum #'(pre-form ...)) + "__" + ,@(syntax->datum #'(post-form ...))) + "\n" + " __ templates are not supported for foreign macros.\n" + " Use _'s to indicate a specific number of expected arguments, instead.")))] + [(name pre-form ... (~datum _) post-form ...) + (foreign-macro-template-expand + (datum->syntax this-syntax + (cons #'original-macro + (cdr (syntax->list this-syntax)))))] + [(name form ...) + #:do [(define chirality (syntax-property this-syntax 'chirality))] + (if (and chirality (eq? chirality 'right)) + #'(esc (lambda (v) (original-macro form ... v))) + #'(esc (lambda (v) (original-macro v form ...))))] + [name:id #'(esc (lambda (v) (original-macro v)))]))) (define-syntax define-qi-syntax-rule (syntax-parser [(_ (name . pat) template) - #'(define-qi-syntax name - (qi-macro - (syntax-parser - [(_ . pat) #'template])))])) + #'(define-dsl-syntax name qi-macro + (syntax-parser + [(_ . pat) #'template]))])) (define-syntax define-qi-syntax-parser (syntax-parser [(_ name clause ...) - #'(define-qi-syntax name - (qi-macro - (syntax-parser - clause ...)))])) + #'(define-dsl-syntax name qi-macro + (syntax-parser + clause ...))])) (define-syntax define-qi-foreign-syntaxes (syntax-parser [(_ form-name ...) #'(begin - (define-qi-syntax form-name (make-qi-foreign-syntax-transformer #'form-name)) + (define-dsl-syntax form-name qi-macro + (make-qi-foreign-syntax-transformer #'form-name)) ...)])) From 0ee3d183da58543b3bee0cee36f98aaa312c8fb9 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 09:58:51 -0700 Subject: [PATCH 064/108] Integrate POC extension of deforestation to implement `map` This integrates the proof-of-concept "deep macro" extension scheme for deforestation that we have been working on in the weekly meetings. For now, only `map` is implemented using the new approach, and though user-level tests pass, some compiler tests are currently failing. To keep things simple, this temporarily introduces a parallel `#%deforestable2` form for this purpose so that we can implement list operations one at a time and test things in isolation before going whole hog and replacing `#%deforestable` with the new version. --- qi-lib/flow/aux-syntax.rkt | 14 +++++++-- qi-lib/flow/core/compiler/1000-qi0.rkt | 22 +++++++++++--- qi-lib/flow/core/syntax.rkt | 7 ++++- qi-lib/flow/extended/expander.rkt | 5 +++ qi-lib/list.rkt | 9 ++++-- qi-lib/macro.rkt | 42 +++++++++++++++++++++++++- 6 files changed, 88 insertions(+), 11 deletions(-) diff --git a/qi-lib/flow/aux-syntax.rkt b/qi-lib/flow/aux-syntax.rkt index e5cf653a4..2ef0aa1a3 100644 --- a/qi-lib/flow/aux-syntax.rkt +++ b/qi-lib/flow/aux-syntax.rkt @@ -3,10 +3,12 @@ (provide literal subject clause - starts-with) + starts-with + (struct-out deforestable-info)) (require syntax/parse - racket/string) + racket/string + (for-syntax racket/base)) (define-syntax-class literal (pattern @@ -56,3 +58,11 @@ (symbol->string (syntax-e #'i)) pfx))) + +;; A datatype used at compile time to convey user-defined data through +;; the various stages of compilation for the purposes of extending Qi +;; deforestation to custom list operations. It is currently used to +;; convey a Racket runtime for macros in qi/list through to the code +;; generation stage of Qi compilation (and could be used by any similar +;; "deep" macros written by users). +(struct deforestable-info [codegen]) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index de644c2b7..3d02807d7 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -6,6 +6,7 @@ racket/function racket/list (for-syntax racket/base + racket/match syntax/parse "../syntax.rkt" "../../aux-syntax.rkt" @@ -13,12 +14,9 @@ )) (begin-for-syntax - (define-and-register-pass 1000 (qi0-wrapper stx) (syntax-parse stx - (ex #'(qi0->racket ex)))) - - ) + (ex #'(qi0->racket ex))))) (define-syntax (qi0->racket stx) ;; this is a macro so it receives the entire expression @@ -96,6 +94,7 @@ [(~datum appleye) #'call] [e:clos-form (clos-parser #'e)] + [e:deforestable2-form (deforestable2-parser #'e)] [e:deforestable-form (deforestable-parser #'e)] ;; escape hatch for racket expressions or anything ;; to be "passed through" @@ -394,6 +393,21 @@ the DSL. (qi0->racket (~> (-< (~> (gen args) △) _) onex))))])) + (define (deforestable2-clause-parser c) + (syntax-parse c + [((~datum f) e) #'(qi0->racket e)] + [((~datum e) e) #'e])) + + (define (deforestable2-parser e) + (syntax-parse e + #:datum-literals (#%optimizable-app) + [((~datum #%deforestable2) op c ...) + (define es^ (map deforestable2-clause-parser (attribute c))) + (define info (syntax-local-value #'op)) + (match info + [(deforestable-info codegen) + (apply codegen es^)])])) + (define (deforestable-parser stx) (syntax-parse stx [((~datum #%deforestable) (~datum filter) (proc:clause)) diff --git a/qi-lib/flow/core/syntax.rkt b/qi-lib/flow/core/syntax.rkt index e70ff09e3..3ba787dc8 100644 --- a/qi-lib/flow/core/syntax.rkt +++ b/qi-lib/flow/core/syntax.rkt @@ -18,7 +18,8 @@ fold-right-form loop-form clos-form - deforestable-form) + deforestable-form + deforestable2-form) (require syntax/parse) @@ -139,3 +140,7 @@ See comments in flow.rkt for more details. (define-syntax-class deforestable-form (pattern ((~datum #%deforestable) arg ...))) + +(define-syntax-class deforestable2-form + (pattern + ((~datum #%deforestable2) arg ...))) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index 580c138d3..bd6e53bfe 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -187,6 +187,7 @@ core language's use of #%app, etc.). (#%deforestable name:id (f:closed-floe ...) (arg:racket-expr ...)) (#%deforestable name:id (f:closed-floe ...+)) (#%deforestable name:id) + (#%deforestable2 name:id e:deforestable-clause ...) ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) @@ -242,6 +243,10 @@ core language's use of #%app, etc.). #:with spaced-f (introduce-qi-syntax #'f) #'(esc spaced-f))) + (nonterminal deforestable-clause + ((~datum f) e:closed-floe) + ((~datum e) g:racket-expr)) + (nonterminal arg-stx (~datum _) (~datum __) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 0d96362d3..6925f8f8d 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -9,10 +9,13 @@ "flow/extended/expander.rkt" (only-in "flow/space.rkt" define-qi-alias) - "macro.rkt") + "macro.rkt" + (prefix-in r: racket/base)) -(define-qi-syntax-rule (map f:expr) - (#%deforestable map (f))) +(define-deforestable + (map [f f]) + #'(lambda (vs) ; single list arg + (r:map f vs))) (define-qi-syntax-rule (filter f:expr) (#%deforestable filter (f))) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index 678063cbc..ef09f3f63 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -4,6 +4,7 @@ define-qi-syntax-rule define-qi-syntax-parser define-qi-foreign-syntaxes + define-deforestable (for-syntax qi-macro)) (require (for-syntax racket/base @@ -12,8 +13,10 @@ racket/list) (only-in "flow/extended/expander.rkt" qi-macro - esc) + esc + #%deforestable2) qi/flow/space + (for-syntax qi/flow/aux-syntax) syntax/parse/define syntax/parse syntax-spec-v2) @@ -108,3 +111,40 @@ (define-dsl-syntax form-name qi-macro (make-qi-foreign-syntax-transformer #'form-name)) ...)])) + +(begin-for-syntax + (define (op-transformer info spec) + ;; use the `spec` to rewrite the source expression to expand + ;; to a corresponding number of clauses in the core form, like: + ;; (op e1 e2 e3) → (#%optimizable-app #,info [f e1] [e e2] [f e3]) + (syntax-parse spec + [([tag arg-name] ...) + (syntax-parser + [(_ e ...) (if (= (length (attribute e)) + (length (attribute arg-name))) + #`(#%deforestable2 #,info [tag e] ...) + (raise-syntax-error #f + "Wrong number of arguments!" + this-syntax))])]))) + +(define-syntax define-deforestable + (syntax-parser + [(_ (name spec ...) codegen) + #:with ([typ arg] ...) #'(spec ...) + #:with codegen-f #'(lambda (arg ...) + ;; var bindings vs pattern bindings + ;; arg are syntax objects but we can't + ;; use them as variable bindings, so + ;; we use with-syntax to handle them + ;; as pattern bindings + (with-syntax ([arg arg] ...) + codegen)) + #'(begin + + ;; capture the codegen in an instance of + ;; the compile time struct + (define-syntax info + (deforestable-info codegen-f)) + + (define-dsl-syntax name qi-macro + (op-transformer #'info #'(spec ...))))])) From e84d87f11d34381b8935cf101594663402198c12 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 15:36:51 -0700 Subject: [PATCH 065/108] Add a `name` argument to `define-deforestable` The deforestation pass needs a name (e.g. `map`) to match in order to apply optimizations. This updates the syntax class responsible for matching `map` to use the new deforestable core form syntax and fixes the failing compiler tests. (done in today's meeting) --- qi-lib/flow/core/compiler/1000-qi0.rkt | 12 ++++++------ qi-lib/flow/core/compiler/deforest/syntax.rkt | 2 +- qi-lib/flow/extended/expander.rkt | 2 +- qi-lib/macro.rkt | 6 +++--- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 3d02807d7..abb584e95 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -401,12 +401,12 @@ the DSL. (define (deforestable2-parser e) (syntax-parse e #:datum-literals (#%optimizable-app) - [((~datum #%deforestable2) op c ...) - (define es^ (map deforestable2-clause-parser (attribute c))) - (define info (syntax-local-value #'op)) - (match info - [(deforestable-info codegen) - (apply codegen es^)])])) + [((~datum #%deforestable2) _name info c ...) + (let ([es^ (map deforestable2-clause-parser (attribute c))] + [info (syntax-local-value #'info)]) + (match info + [(deforestable-info codegen) + (apply codegen es^)]))])) (define (deforestable-parser stx) (syntax-parse stx diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 405c81578..bcc65ac9d 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -85,7 +85,7 @@ #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (map) - (pattern (#%deforestable map (f-uncompiled)) + (pattern (#%deforestable2 map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-filter-map diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index bd6e53bfe..04abd74a1 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -187,7 +187,7 @@ core language's use of #%app, etc.). (#%deforestable name:id (f:closed-floe ...) (arg:racket-expr ...)) (#%deforestable name:id (f:closed-floe ...+)) (#%deforestable name:id) - (#%deforestable2 name:id e:deforestable-clause ...) + (#%deforestable2 name:id info:id e:deforestable-clause ...) ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index ef09f3f63..eb532bd56 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -113,7 +113,7 @@ ...)])) (begin-for-syntax - (define (op-transformer info spec) + (define (op-transformer name info spec) ;; use the `spec` to rewrite the source expression to expand ;; to a corresponding number of clauses in the core form, like: ;; (op e1 e2 e3) → (#%optimizable-app #,info [f e1] [e e2] [f e3]) @@ -122,7 +122,7 @@ (syntax-parser [(_ e ...) (if (= (length (attribute e)) (length (attribute arg-name))) - #`(#%deforestable2 #,info [tag e] ...) + #`(#%deforestable2 #,name #,info [tag e] ...) (raise-syntax-error #f "Wrong number of arguments!" this-syntax))])]))) @@ -147,4 +147,4 @@ (deforestable-info codegen-f)) (define-dsl-syntax name qi-macro - (op-transformer #'info #'(spec ...))))])) + (op-transformer #'name #'info #'(spec ...))))])) From 39d0aba290a4b91200523694e03eac3beb84e310 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 16:24:15 -0700 Subject: [PATCH 066/108] `make` target to run just `qi/list` tests --- Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Makefile b/Makefile index fd82677d3..3658b7c1d 100644 --- a/Makefile +++ b/Makefile @@ -125,6 +125,9 @@ test: test-flow: racket -y $(PACKAGE-NAME)-test/tests/flow.rkt +test-list: + racket -y $(PACKAGE-NAME)-test/tests/list.rkt + test-on: racket -y $(PACKAGE-NAME)-test/tests/on.rkt From 4d29edefd363020e1c5854298d7ef4644799573e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 16:25:12 -0700 Subject: [PATCH 067/108] translate `filter` to use `define-deforestable` --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 3 ++- qi-lib/list.rkt | 6 ++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index bcc65ac9d..ed20dcb4b 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -79,8 +79,9 @@ #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter) - (pattern (#%deforestable filter (f-uncompiled)) + (pattern (#%deforestable2 filter _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) + (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 6925f8f8d..d81466136 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -17,8 +17,10 @@ #'(lambda (vs) ; single list arg (r:map f vs))) -(define-qi-syntax-rule (filter f:expr) - (#%deforestable filter (f))) +(define-deforestable + (filter [f f]) + #'(λ (vs) + (r:filter f vs))) (define-qi-syntax-rule (filter-map f:expr) (#%deforestable filter-map (f))) From ce964f07de326c9e1d40781ce790c6ffef463087 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 16:44:49 -0700 Subject: [PATCH 068/108] translate `filter-map` to use `define-deforestable` --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 2 +- qi-lib/list.rkt | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index ed20dcb4b..f42437fea 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -93,7 +93,7 @@ #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter-map) - (pattern (#%deforestable filter-map (f-uncompiled)) + (pattern (#%deforestable2 filter-map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-take diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index d81466136..47fb4d53f 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -10,7 +10,8 @@ (only-in "flow/space.rkt" define-qi-alias) "macro.rkt" - (prefix-in r: racket/base)) + (prefix-in r: racket/base) + (prefix-in r: racket/list)) (define-deforestable (map [f f]) @@ -22,8 +23,10 @@ #'(λ (vs) (r:filter f vs))) -(define-qi-syntax-rule (filter-map f:expr) - (#%deforestable filter-map (f))) +(define-deforestable + (filter-map [f f]) + #'(λ (vs) + (r:filter-map f vs))) (define-qi-syntax-rule (foldl f:expr init:expr) (#%deforestable foldl (f) (init))) From 0db81b0fdd909bc4c587514276cf61863c03d3e4 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 16:47:47 -0700 Subject: [PATCH 069/108] translate `foldl` and `foldr` --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 14 ++++++++------ qi-lib/list.rkt | 12 ++++++++---- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index f42437fea..ed38c671e 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -124,20 +124,22 @@ #:attributes (op init) #:literal-sets (fs-literals) #:datum-literals (foldr) - (pattern (#%deforestable + (pattern (#%deforestable2 foldr - (op-uncompiled) - ((#%host-expression init))) + _name + ((~datum f) op-uncompiled) + ((~datum e) init)) #:attr op (run-passes #'op-uncompiled))) (define-syntax-class fsc-foldl #:attributes (op init) #:literal-sets (fs-literals) #:datum-literals (foldl) - (pattern (#%deforestable + (pattern (#%deforestable2 foldl - (op-uncompiled) - ((#%host-expression init))) + _name + ((~datum f) op-uncompiled) + ((~datum e) init)) #:attr op (run-passes #'op-uncompiled))) (define-syntax-class cad*r-datum diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 47fb4d53f..091b31561 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -28,11 +28,15 @@ #'(λ (vs) (r:filter-map f vs))) -(define-qi-syntax-rule (foldl f:expr init:expr) - (#%deforestable foldl (f) (init))) +(define-deforestable + (foldl [f f] [e init]) + #'(λ (vs) + (r:foldl f init vs))) -(define-qi-syntax-rule (foldr f:expr init:expr) - (#%deforestable foldr (f) (init))) +(define-deforestable + (foldr [f f] [e init]) + #'(λ (vs) + (r:foldr f init vs))) (define-qi-syntax-parser range [(_ low:expr high:expr step:expr) #'(#%deforestable range () (low high step))] From 1a5e4d1dcd17b9b597013d4fd8d34168fd21814d Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 16:59:37 -0700 Subject: [PATCH 070/108] translate `take` to use `define-deforestable` --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 2 +- qi-lib/list.rkt | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index ed38c671e..826c364be 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -100,7 +100,7 @@ #:attributes (n) #:literal-sets (fs-literals) #:datum-literals (take) - (pattern (#%deforestable take () ((#%host-expression n))))) + (pattern (#%deforestable2 take _info ((~datum e) n)))) (define-syntax-class fst-syntax0 (pattern (~or _:fst-filter diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 091b31561..bc42e9a3a 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -49,8 +49,10 @@ "(range arg ...)" "range expects at least one argument")]) -(define-qi-syntax-rule (take n:expr) - (#%deforestable take () (n))) +(define-deforestable + (take [e n]) + #'(λ (vs) + (r:take vs n))) (define-qi-syntax-parser car [_:id #'(#%deforestable car)]) From ae06392225269c1ee4da60b9e7c1abb2c5aadfd8 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 17:01:21 -0700 Subject: [PATCH 071/108] format like ordinary definitions --- qi-lib/list.rkt | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index bc42e9a3a..38ab372ba 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -13,28 +13,23 @@ (prefix-in r: racket/base) (prefix-in r: racket/list)) -(define-deforestable - (map [f f]) +(define-deforestable (map [f f]) #'(lambda (vs) ; single list arg (r:map f vs))) -(define-deforestable - (filter [f f]) +(define-deforestable (filter [f f]) #'(λ (vs) (r:filter f vs))) -(define-deforestable - (filter-map [f f]) +(define-deforestable (filter-map [f f]) #'(λ (vs) (r:filter-map f vs))) -(define-deforestable - (foldl [f f] [e init]) +(define-deforestable (foldl [f f] [e init]) #'(λ (vs) (r:foldl f init vs))) -(define-deforestable - (foldr [f f] [e init]) +(define-deforestable (foldr [f f] [e init]) #'(λ (vs) (r:foldr f init vs))) @@ -49,8 +44,7 @@ "(range arg ...)" "range expects at least one argument")]) -(define-deforestable - (take [e n]) +(define-deforestable (take [e n]) #'(λ (vs) (r:take vs n))) From 2e376f9863391e3f532b6d34b184a98e0ed3c9b4 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 17:02:17 -0700 Subject: [PATCH 072/108] fix ignored variable name --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 826c364be..bcd7b7cba 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -126,7 +126,7 @@ #:datum-literals (foldr) (pattern (#%deforestable2 foldr - _name + _info ((~datum f) op-uncompiled) ((~datum e) init)) #:attr op (run-passes #'op-uncompiled))) @@ -137,7 +137,7 @@ #:datum-literals (foldl) (pattern (#%deforestable2 foldl - _name + _info ((~datum f) op-uncompiled) ((~datum e) init)) #:attr op (run-passes #'op-uncompiled))) From 45f29ec4ab24a6032bbbc9bb088572a725852571 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 17:06:04 -0700 Subject: [PATCH 073/108] adopt style suggestion from Ben / resyntax (cr) --- qi-lib/flow/core/compiler/1000-qi0.rkt | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index abb584e95..4ddae7e16 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -400,13 +400,11 @@ the DSL. (define (deforestable2-parser e) (syntax-parse e - #:datum-literals (#%optimizable-app) - [((~datum #%deforestable2) _name info c ...) - (let ([es^ (map deforestable2-clause-parser (attribute c))] - [info (syntax-local-value #'info)]) - (match info - [(deforestable-info codegen) - (apply codegen es^)]))])) + #:datum-literals (#%deforestable2) + [(#%deforestable2 _name info c ...) + (let ([es^ (map deforestable2-clause-parser (attribute c))]) + (match-let ([(deforestable-info codegen) (syntax-local-value #'info)]) + (apply codegen es^)))])) (define (deforestable-parser stx) (syntax-parse stx From 19d50681f639dea19cbc2327b8154ea890ac7383 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 19:12:04 -0700 Subject: [PATCH 074/108] translate `car`, `cad*r` etc., and `list-ref` Our extension scheme did not support identifier-based forms like `car`, so a few modifications to it were necessary. --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 13 +++++---- qi-lib/list.rkt | 21 +++++++------- qi-lib/macro.rkt | 28 ++++++++++++++----- 3 files changed, 39 insertions(+), 23 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index bcd7b7cba..d08045888 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -144,17 +144,18 @@ (define-syntax-class cad*r-datum #:attributes (countdown) - (pattern (#%deforestable (~datum car)) #:attr countdown #'0) - (pattern (#%deforestable (~datum cadr)) #:attr countdown #'1) - (pattern (#%deforestable (~datum caddr)) #:attr countdown #'2) - (pattern (#%deforestable (~datum cadddr)) #:attr countdown #'3)) + #:datum-literals (#%deforestable2 car cadr caddr cadddr) + (pattern (#%deforestable2 car _info) #:attr countdown #'0) + (pattern (#%deforestable2 cadr _info) #:attr countdown #'1) + (pattern (#%deforestable2 caddr _info) #:attr countdown #'2) + (pattern (#%deforestable2 cadddr _info) #:attr countdown #'3)) (define-syntax-class fsc-list-ref #:attributes (pos name) #:literal-sets (fs-literals) - #:datum-literals (list-ref) + #:datum-literals (#%deforestable2 list-ref) ;; TODO: need #%host-expression wrapping idx? - (pattern (#%deforestable list-ref () (idx)) + (pattern (#%deforestable2 list-ref _info ((~datum e) idx)) #:attr pos #'idx #:attr name #'list-ref) ;; TODO: bring wrapping #%deforestable out here? diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 38ab372ba..47d4f553f 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -48,20 +48,21 @@ #'(λ (vs) (r:take vs n))) -(define-qi-syntax-parser car - [_:id #'(#%deforestable car)]) +(define-deforestable car + #'r:car) -(define-qi-syntax-parser cadr - [_:id #'(#%deforestable cadr)]) +(define-deforestable cadr + #'r:cadr) -(define-qi-syntax-parser caddr - [_:id #'(#%deforestable caddr)]) +(define-deforestable caddr + #'r:caddr) -(define-qi-syntax-parser cadddr - [_:id #'(#%deforestable cadddr)]) +(define-deforestable cadddr + #'r:cadddr) -(define-qi-syntax-rule (list-ref n:expr) - (#%deforestable list-ref () (n))) +(define-deforestable (list-ref [e n]) + #'(λ (vs) + (r:list-ref vs n))) (define-qi-syntax-parser length [_:id #'(#%deforestable length)]) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index eb532bd56..e990569fd 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -120,12 +120,15 @@ (syntax-parse spec [([tag arg-name] ...) (syntax-parser - [(_ e ...) (if (= (length (attribute e)) - (length (attribute arg-name))) - #`(#%deforestable2 #,name #,info [tag e] ...) - (raise-syntax-error #f - "Wrong number of arguments!" - this-syntax))])]))) + [(_ e ...+) (if (= (length (attribute e)) + (length (attribute arg-name))) + #`(#%deforestable2 #,name #,info [tag e] ...) + (raise-syntax-error #f + "Wrong number of arguments!" + this-syntax))] + ;; TODO, check: instead of `car`, does `(car)` produce + ;; a useful syntax error? + [_:id #`(#%deforestable2 #,name #,info)])]))) (define-syntax define-deforestable (syntax-parser @@ -147,4 +150,15 @@ (deforestable-info codegen-f)) (define-dsl-syntax name qi-macro - (op-transformer #'name #'info #'(spec ...))))])) + (op-transformer #'name #'info #'(spec ...))))] + [(_ name:id codegen) + #:with codegen-f #'(lambda () codegen) + #'(begin + + ;; capture the codegen in an instance of + ;; the compile time struct + (define-syntax info + (deforestable-info codegen-f)) + + (define-dsl-syntax name qi-macro + (op-transformer #'name #'info #'())))])) From a5f26527adfbd45a494e5d6bafbef116c4cf841f Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 19:14:56 -0700 Subject: [PATCH 075/108] declare `deforestable2` as a datum literal This avoids an "unused binding" warning --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index d08045888..8aaedf17a 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -78,28 +78,28 @@ (define-syntax-class fst-filter #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (filter) + #:datum-literals (#%deforestable2 filter) (pattern (#%deforestable2 filter _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (map) + #:datum-literals (#%deforestable2 map) (pattern (#%deforestable2 map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-filter-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (filter-map) + #:datum-literals (#%deforestable2 filter-map) (pattern (#%deforestable2 filter-map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-take #:attributes (n) #:literal-sets (fs-literals) - #:datum-literals (take) + #:datum-literals (#%deforestable2 take) (pattern (#%deforestable2 take _info ((~datum e) n)))) (define-syntax-class fst-syntax0 @@ -123,7 +123,7 @@ (define-syntax-class fsc-foldr #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (foldr) + #:datum-literals (#%deforestable2 foldr) (pattern (#%deforestable2 foldr _info @@ -134,7 +134,7 @@ (define-syntax-class fsc-foldl #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (foldl) + #:datum-literals (#%deforestable2 foldl) (pattern (#%deforestable2 foldl _info From 8a5d650718f2c775ebdddc106df9f5b125f42603 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 19:18:41 -0700 Subject: [PATCH 076/108] translate `length` to use `define-deforestable` --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 4 ++-- qi-lib/list.rkt | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 8aaedf17a..0701b7624 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -165,8 +165,8 @@ (define-syntax-class fsc-length #:literal-sets (fs-literals) - #:datum-literals (length) - (pattern (#%deforestable length))) + #:datum-literals (#%deforestable2 length) + (pattern (#%deforestable2 length _info))) (define-syntax-class fsc-empty? #:literal-sets (fs-literals) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 47d4f553f..42337c96a 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -64,8 +64,8 @@ #'(λ (vs) (r:list-ref vs n))) -(define-qi-syntax-parser length - [_:id #'(#%deforestable length)]) +(define-deforestable length + #'r:length) (define-qi-syntax-parser empty? [_:id #'(#%deforestable empty?)]) From f6cecbb043e88082366dc030e11fb6e7240a1a87 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 19:23:40 -0700 Subject: [PATCH 077/108] translate `empty?` and (its alias) `null?` to `define-deforestable` --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 5 ++--- qi-lib/list.rkt | 4 ++-- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 0701b7624..ef2965ac4 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -170,9 +170,8 @@ (define-syntax-class fsc-empty? #:literal-sets (fs-literals) - #:datum-literals (null? empty?) - (pattern (#%deforestable (~or empty? - null?)))) + #:datum-literals (#%deforestable2 empty?) ; note: null? expands to empty? + (pattern (#%deforestable2 empty? _info))) (define-syntax-class fsc-default #:datum-literals (cstream->list) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 42337c96a..03dc87d9d 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -67,7 +67,7 @@ (define-deforestable length #'r:length) -(define-qi-syntax-parser empty? - [_:id #'(#%deforestable empty?)]) +(define-deforestable empty? + #'r:empty?) (define-qi-alias null? empty?) From c047a0170109813b3388b20873e21a67f6cd8ebf Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 23:43:06 -0700 Subject: [PATCH 078/108] Use the "clever hack" to translate `range` We'd like to support multiple syntaxes for `range` that all expand to a canonical form, and at the same time, provide a single codegen for that canonical form. We don't already have a way to do this with `define-deforestable` directly, so we just write `range` as an ordinary Qi macro that expands to a use of the canonically-defined `range2`. See today's meeting notes for more on this. --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 4 ++-- qi-lib/list.rkt | 10 +++++++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index ef2965ac4..7daf29427 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -49,8 +49,8 @@ (define-syntax-class fsp-range #:attributes (blanket? fine? arg pre-arg post-arg) #:literal-sets (fs-literals) - #:datum-literals (range) - (pattern (#%deforestable range () (the-arg ...)) + #:datum-literals (#%deforestable2 range2) + (pattern (#%deforestable2 range2 _info ((~datum e) the-arg) ...) #:attr arg #'(the-arg ...) #:attr pre-arg #f #:attr post-arg #f diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 03dc87d9d..42ef47670 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -33,10 +33,14 @@ #'(λ (vs) (r:foldr f init vs))) +(define-deforestable (range2 [e low] [e high] [e step]) + #'(λ () + (r:range low high step))) + (define-qi-syntax-parser range - [(_ low:expr high:expr step:expr) #'(#%deforestable range () (low high step))] - [(_ low:expr high:expr) #'(#%deforestable range () (low high 1))] - [(_ high:expr) #'(#%deforestable range () (0 high 1))] + [(_ low:expr high:expr step:expr) #'(range2 low high step)] + [(_ low:expr high:expr) #'(range2 low high 1)] + [(_ high:expr) #'(range2 0 high 1)] ;; not strictly necessary but this provides a better error ;; message than simply "range: bad syntax" that's warranted ;; to differentiate from racket/list's `range` From 0df78235558f4482b7ec21ec8f0c3bc8dc116987 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 22 Nov 2024 23:56:42 -0700 Subject: [PATCH 079/108] Be cleverer in hiding the "clever hack" Use `range` internally, and re-export the user-facing `range2` so it is also visible as `range` externally, for the best of both worlds. --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 4 ++-- qi-lib/list.rkt | 22 ++++++++++++++----- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 7daf29427..2f01e629a 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -49,8 +49,8 @@ (define-syntax-class fsp-range #:attributes (blanket? fine? arg pre-arg post-arg) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 range2) - (pattern (#%deforestable2 range2 _info ((~datum e) the-arg) ...) + #:datum-literals (#%deforestable2 range) + (pattern (#%deforestable2 range _info ((~datum e) the-arg) ...) #:attr arg #'(the-arg ...) #:attr pre-arg #f #:attr post-arg #f diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index 42ef47670..dd0c57fd4 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -1,7 +1,10 @@ #lang racket/base (provide (for-space qi - (all-defined-out))) + (except-out (all-defined-out) + range2 + range) + (rename-out [range2 range]))) (require (for-syntax racket/base "private/util.rkt") @@ -33,14 +36,21 @@ #'(λ (vs) (r:foldr f init vs))) -(define-deforestable (range2 [e low] [e high] [e step]) +(define-deforestable (range [e low] [e high] [e step]) #'(λ () (r:range low high step))) -(define-qi-syntax-parser range - [(_ low:expr high:expr step:expr) #'(range2 low high step)] - [(_ low:expr high:expr) #'(range2 low high 1)] - [(_ high:expr) #'(range2 0 high 1)] +;; We'd like to indicate multiple surface variants for `range` that +;; expand to a canonical form, and provide a single codegen just for the +;; canonical form. +;; Since `define-deforestable` doesn't support indicating multiple cases +;; yet, we use the ordinary macro machinery to expand surface variants of +;; `range` to a canonical form that is defined using +;; `define-deforestable`. +(define-qi-syntax-parser range2 + [(_ low:expr high:expr step:expr) #'(range low high step)] + [(_ low:expr high:expr) #'(range low high 1)] + [(_ high:expr) #'(range 0 high 1)] ;; not strictly necessary but this provides a better error ;; message than simply "range: bad syntax" that's warranted ;; to differentiate from racket/list's `range` From 3f8a7c4579e50db73a40a4b529eb6e7b680e10da Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sat, 23 Nov 2024 00:05:04 -0700 Subject: [PATCH 080/108] adopt `syntax-parse` idiom for errors (cr) --- qi-lib/macro.rkt | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index e990569fd..17d1a019d 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -120,12 +120,11 @@ (syntax-parse spec [([tag arg-name] ...) (syntax-parser - [(_ e ...+) (if (= (length (attribute e)) - (length (attribute arg-name))) - #`(#%deforestable2 #,name #,info [tag e] ...) - (raise-syntax-error #f - "Wrong number of arguments!" - this-syntax))] + [(_ e ...+) + #:fail-unless (= (length (attribute e)) + (length (attribute arg-name))) + "Wrong number of arguments!" + #`(#%deforestable2 #,name #,info [tag e] ...)] ;; TODO, check: instead of `car`, does `(car)` produce ;; a useful syntax error? [_:id #`(#%deforestable2 #,name #,info)])]))) From c9db34cf59d59e168abec3239d5d0413742e3f20 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sat, 23 Nov 2024 00:20:39 -0700 Subject: [PATCH 081/108] Fully replace `#%deforestable` with the new implementation This replaces the original implementation of the `#%deforestable` core form with the new one that had been named `#%deforestable2` during the process of incrementally integrating the proof-of-concept for this scheme. With that complete, this now gets rid of the hardcoded codegen for the `qi/list` forms in the Qi compiler, instead replacing it with the ability to specify this in the `define-deforestable` macro which then conveys the codegen through to the final stage of compilation via a compile-time datatype. This also removes some tests that are no longer relevant and updates others. The recent Qi meeting notes provide more context on this approach. --- qi-lib/flow/core/compiler/1000-qi0.rkt | 50 ++----------------- qi-lib/flow/core/compiler/deforest/syntax.rkt | 50 +++++++++---------- qi-lib/flow/core/syntax.rkt | 7 +-- qi-lib/flow/extended/expander.rkt | 5 +- qi-lib/macro.rkt | 6 +-- qi-test/tests/expander.rkt | 7 +-- qi-test/tests/flow.rkt | 10 ---- 7 files changed, 39 insertions(+), 96 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 4ddae7e16..12ca24065 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -94,7 +94,6 @@ [(~datum appleye) #'call] [e:clos-form (clos-parser #'e)] - [e:deforestable2-form (deforestable2-parser #'e)] [e:deforestable-form (deforestable-parser #'e)] ;; escape hatch for racket expressions or anything ;; to be "passed through" @@ -393,58 +392,19 @@ the DSL. (qi0->racket (~> (-< (~> (gen args) △) _) onex))))])) - (define (deforestable2-clause-parser c) + (define (deforestable-clause-parser c) (syntax-parse c [((~datum f) e) #'(qi0->racket e)] [((~datum e) e) #'e])) - (define (deforestable2-parser e) + (define (deforestable-parser e) (syntax-parse e - #:datum-literals (#%deforestable2) - [(#%deforestable2 _name info c ...) - (let ([es^ (map deforestable2-clause-parser (attribute c))]) + #:datum-literals (#%deforestable) + [(#%deforestable _name info c ...) + (let ([es^ (map deforestable-clause-parser (attribute c))]) (match-let ([(deforestable-info codegen) (syntax-local-value #'info)]) (apply codegen es^)))])) - (define (deforestable-parser stx) - (syntax-parse stx - [((~datum #%deforestable) (~datum filter) (proc:clause)) - #'(lambda (v) - (filter (qi0->racket proc) v))] - [((~datum #%deforestable) (~datum filter-map) (proc:clause)) - #'(lambda (v) - (filter-map (qi0->racket proc) v))] - [((~datum #%deforestable) (~datum map) (proc:clause)) - #'(lambda (v) - (map (qi0->racket proc) v))] - [((~datum #%deforestable) (~datum foldl) (proc:clause) (init:expr)) - #'(lambda (v) - (foldl (qi0->racket proc) init v))] - [((~datum #%deforestable) (~datum foldr) (proc:clause) (init:expr)) - #'(lambda (v) - (foldr (qi0->racket proc) init v))] - [((~datum #%deforestable) (~datum range) () (arg:expr ...)) - #'(lambda () - (range arg ...))] - [((~datum #%deforestable) (~datum take) () (n:expr)) - #'(lambda (v) - (take v n))] - [((~datum #%deforestable) (~datum car)) - #'car] - [((~datum #%deforestable) (~datum cadr)) - #'cadr] - [((~datum #%deforestable) (~datum caddr)) - #'caddr] - [((~datum #%deforestable) (~datum cadddr)) - #'cadddr] - [((~datum #%deforestable) (~datum list-ref) () (n:expr)) - #'(lambda (v) - (list-ref v n))] - [((~datum #%deforestable) (~datum length)) - #'length] - [((~datum #%deforestable) (~or* (~datum empty?) (~datum null?))) - #'empty?])) - (define (blanket-template-form-parser stx) (syntax-parse stx ;; "prarg" = "pre-supplied argument" diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index 2f01e629a..be2e090b0 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -49,8 +49,8 @@ (define-syntax-class fsp-range #:attributes (blanket? fine? arg pre-arg post-arg) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 range) - (pattern (#%deforestable2 range _info ((~datum e) the-arg) ...) + #:datum-literals (#%deforestable range) + (pattern (#%deforestable range _info ((~datum e) the-arg) ...) #:attr arg #'(the-arg ...) #:attr pre-arg #f #:attr post-arg #f @@ -78,29 +78,29 @@ (define-syntax-class fst-filter #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 filter) - (pattern (#%deforestable2 filter _info ((~datum f) f-uncompiled)) + #:datum-literals (#%deforestable filter) + (pattern (#%deforestable filter _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 map) - (pattern (#%deforestable2 map _info ((~datum f) f-uncompiled)) + #:datum-literals (#%deforestable map) + (pattern (#%deforestable map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-filter-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 filter-map) - (pattern (#%deforestable2 filter-map _info ((~datum f) f-uncompiled)) + #:datum-literals (#%deforestable filter-map) + (pattern (#%deforestable filter-map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-take #:attributes (n) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 take) - (pattern (#%deforestable2 take _info ((~datum e) n)))) + #:datum-literals (#%deforestable take) + (pattern (#%deforestable take _info ((~datum e) n)))) (define-syntax-class fst-syntax0 (pattern (~or _:fst-filter @@ -123,8 +123,8 @@ (define-syntax-class fsc-foldr #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 foldr) - (pattern (#%deforestable2 + #:datum-literals (#%deforestable foldr) + (pattern (#%deforestable foldr _info ((~datum f) op-uncompiled) @@ -134,8 +134,8 @@ (define-syntax-class fsc-foldl #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 foldl) - (pattern (#%deforestable2 + #:datum-literals (#%deforestable foldl) + (pattern (#%deforestable foldl _info ((~datum f) op-uncompiled) @@ -144,18 +144,18 @@ (define-syntax-class cad*r-datum #:attributes (countdown) - #:datum-literals (#%deforestable2 car cadr caddr cadddr) - (pattern (#%deforestable2 car _info) #:attr countdown #'0) - (pattern (#%deforestable2 cadr _info) #:attr countdown #'1) - (pattern (#%deforestable2 caddr _info) #:attr countdown #'2) - (pattern (#%deforestable2 cadddr _info) #:attr countdown #'3)) + #:datum-literals (#%deforestable car cadr caddr cadddr) + (pattern (#%deforestable car _info) #:attr countdown #'0) + (pattern (#%deforestable cadr _info) #:attr countdown #'1) + (pattern (#%deforestable caddr _info) #:attr countdown #'2) + (pattern (#%deforestable cadddr _info) #:attr countdown #'3)) (define-syntax-class fsc-list-ref #:attributes (pos name) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 list-ref) + #:datum-literals (#%deforestable list-ref) ;; TODO: need #%host-expression wrapping idx? - (pattern (#%deforestable2 list-ref _info ((~datum e) idx)) + (pattern (#%deforestable list-ref _info ((~datum e) idx)) #:attr pos #'idx #:attr name #'list-ref) ;; TODO: bring wrapping #%deforestable out here? @@ -165,13 +165,13 @@ (define-syntax-class fsc-length #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 length) - (pattern (#%deforestable2 length _info))) + #:datum-literals (#%deforestable length) + (pattern (#%deforestable length _info))) (define-syntax-class fsc-empty? #:literal-sets (fs-literals) - #:datum-literals (#%deforestable2 empty?) ; note: null? expands to empty? - (pattern (#%deforestable2 empty? _info))) + #:datum-literals (#%deforestable empty?) ; note: null? expands to empty? + (pattern (#%deforestable empty? _info))) (define-syntax-class fsc-default #:datum-literals (cstream->list) diff --git a/qi-lib/flow/core/syntax.rkt b/qi-lib/flow/core/syntax.rkt index 3ba787dc8..e70ff09e3 100644 --- a/qi-lib/flow/core/syntax.rkt +++ b/qi-lib/flow/core/syntax.rkt @@ -18,8 +18,7 @@ fold-right-form loop-form clos-form - deforestable-form - deforestable2-form) + deforestable-form) (require syntax/parse) @@ -140,7 +139,3 @@ See comments in flow.rkt for more details. (define-syntax-class deforestable-form (pattern ((~datum #%deforestable) arg ...))) - -(define-syntax-class deforestable2-form - (pattern - ((~datum #%deforestable2) arg ...))) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index 04abd74a1..c40d1ae1c 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -184,10 +184,7 @@ core language's use of #%app, etc.). (esc ex:racket-expr) ;; core form to express deforestable operations - (#%deforestable name:id (f:closed-floe ...) (arg:racket-expr ...)) - (#%deforestable name:id (f:closed-floe ...+)) - (#%deforestable name:id) - (#%deforestable2 name:id info:id e:deforestable-clause ...) + (#%deforestable name:id info:id e:deforestable-clause ...) ;; backwards compat macro extensibility via Racket macros (~> ((~var ext-form (starts-with "qi:")) expr ...) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index 17d1a019d..512c55996 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -14,7 +14,7 @@ (only-in "flow/extended/expander.rkt" qi-macro esc - #%deforestable2) + #%deforestable) qi/flow/space (for-syntax qi/flow/aux-syntax) syntax/parse/define @@ -124,10 +124,10 @@ #:fail-unless (= (length (attribute e)) (length (attribute arg-name))) "Wrong number of arguments!" - #`(#%deforestable2 #,name #,info [tag e] ...)] + #`(#%deforestable #,name #,info [tag e] ...)] ;; TODO, check: instead of `car`, does `(car)` produce ;; a useful syntax error? - [_:id #`(#%deforestable2 #,name #,info)])]))) + [_:id #`(#%deforestable #,name #,info)])]))) (define-syntax define-deforestable (syntax-parser diff --git a/qi-test/tests/expander.rkt b/qi-test/tests/expander.rkt index 76b99c3de..baaf30ffa 100644 --- a/qi-test/tests/expander.rkt +++ b/qi-test/tests/expander.rkt @@ -105,10 +105,11 @@ (#%host-expression 1) __)))) (test-expand "#%deforestable" - #'(#%deforestable name (_) (_)) + #'(#%deforestable name info (f 0) (e 0)) #'(#%deforestable name - (_) - ((#%host-expression _))))) + info + (f (gen (#%host-expression 0))) + (e (#%host-expression 0))))) (test-suite "utils" ;; this is just temporary until we properly track source expressions through diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index 67cc4f0e8..f7e765380 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -285,16 +285,6 @@ (check-equal? ((☯ (esc (first (list + *)))) 3 7) 10 "normal racket expressions")) - (test-suite - "#%deforestable" - (check-equal? ((☯ (#%deforestable filter (odd?))) (list 1 2 3)) (list 1 3)) - (check-equal? ((☯ (#%deforestable map (sqr))) (list 1 2 3)) (list 1 4 9)) - (check-equal? ((☯ (#%deforestable foldl (+) (0))) (list 1 2 3)) 6) - (check-equal? ((☯ (#%deforestable foldr (+) (0))) (list 1 2 3)) 6) - (check-equal? ((☯ (#%deforestable range () (3)))) (list 0 1 2)) - (check-equal? ((☯ (#%deforestable range () (0 3)))) (list 0 1 2)) - (check-equal? ((☯ (#%deforestable range () (0 5 2)))) (list 0 2 4)) - (check-equal? ((☯ (#%deforestable take () (2))) (list 1 2 3)) (list 1 2))) (test-suite "elementary boolean gates" (test-suite From 607bd65fdf5d485da819162e63f47279defb46e1 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 29 Nov 2024 12:53:17 -0700 Subject: [PATCH 082/108] Improve handling of identifier forms of deforestable syntax Ensure that the `spec` contains all the information that's needed to parse the syntax in terms of floe and expr positions, instead of having a parallel path for identifier forms. (done in today's meeting) --- qi-lib/macro.rkt | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index 512c55996..d2d3e4618 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -118,20 +118,24 @@ ;; to a corresponding number of clauses in the core form, like: ;; (op e1 e2 e3) → (#%optimizable-app #,info [f e1] [e e2] [f e3]) (syntax-parse spec - [([tag arg-name] ...) + #:datum-literals (op) + [(op [tag arg-name] ...) (syntax-parser [(_ e ...+) #:fail-unless (= (length (attribute e)) (length (attribute arg-name))) "Wrong number of arguments!" - #`(#%deforestable #,name #,info [tag e] ...)] - ;; TODO, check: instead of `car`, does `(car)` produce - ;; a useful syntax error? - [_:id #`(#%deforestable #,name #,info)])]))) + #`(#%deforestable #,name #,info [tag e] ...)])] + ;; TODO, check: instead of `car`, does `(car)` produce + ;; a useful syntax error? + ;; TODO: can add complementary error clauses in these two + ;; patterns; test that default errors are good enough. But if not + ;; can add the error clauses. + [op (syntax-parser [_:id #`(#%deforestable #,name #,info)])]))) (define-syntax define-deforestable (syntax-parser - [(_ (name spec ...) codegen) + [(_ (name spec ...+) codegen) #:with ([typ arg] ...) #'(spec ...) #:with codegen-f #'(lambda (arg ...) ;; var bindings vs pattern bindings @@ -149,7 +153,7 @@ (deforestable-info codegen-f)) (define-dsl-syntax name qi-macro - (op-transformer #'name #'info #'(spec ...))))] + (op-transformer #'name #'info #'(op spec ...))))] [(_ name:id codegen) #:with codegen-f #'(lambda () codegen) #'(begin @@ -160,4 +164,4 @@ (deforestable-info codegen-f)) (define-dsl-syntax name qi-macro - (op-transformer #'name #'info #'())))])) + (op-transformer #'name #'info #'op)))])) From 85ef9e7aff861b498cd0a7f1128019ce8e4961a2 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sat, 30 Nov 2024 03:58:26 -0700 Subject: [PATCH 083/108] declare `#%deforestable` as a literal in `fs-literals` (cr) --- qi-lib/flow/core/compiler/deforest/syntax.rkt | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index be2e090b0..a3fe6d845 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -34,7 +34,7 @@ ;; Literals set used for matching Fusable Stream Literals (define-literal-set fs-literals - #:datum-literals (esc #%host-expression #%fine-template #%blanket-template _ __) + #:datum-literals (esc #%host-expression #%fine-template #%blanket-template #%deforestable _ __) ()) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -49,7 +49,7 @@ (define-syntax-class fsp-range #:attributes (blanket? fine? arg pre-arg post-arg) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable range) + #:datum-literals (range) (pattern (#%deforestable range _info ((~datum e) the-arg) ...) #:attr arg #'(the-arg ...) #:attr pre-arg #f @@ -78,28 +78,28 @@ (define-syntax-class fst-filter #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable filter) + #:datum-literals (filter) (pattern (#%deforestable filter _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable map) + #:datum-literals (map) (pattern (#%deforestable map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-filter-map #:attributes (f) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable filter-map) + #:datum-literals (filter-map) (pattern (#%deforestable filter-map _info ((~datum f) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-take #:attributes (n) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable take) + #:datum-literals (take) (pattern (#%deforestable take _info ((~datum e) n)))) (define-syntax-class fst-syntax0 @@ -123,7 +123,7 @@ (define-syntax-class fsc-foldr #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable foldr) + #:datum-literals (foldr) (pattern (#%deforestable foldr _info @@ -134,7 +134,7 @@ (define-syntax-class fsc-foldl #:attributes (op init) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable foldl) + #:datum-literals (foldl) (pattern (#%deforestable foldl _info @@ -153,7 +153,7 @@ (define-syntax-class fsc-list-ref #:attributes (pos name) #:literal-sets (fs-literals) - #:datum-literals (#%deforestable list-ref) + #:datum-literals (list-ref) ;; TODO: need #%host-expression wrapping idx? (pattern (#%deforestable list-ref _info ((~datum e) idx)) #:attr pos #'idx @@ -165,12 +165,12 @@ (define-syntax-class fsc-length #:literal-sets (fs-literals) - #:datum-literals (#%deforestable length) + #:datum-literals (length) (pattern (#%deforestable length _info))) (define-syntax-class fsc-empty? #:literal-sets (fs-literals) - #:datum-literals (#%deforestable empty?) ; note: null? expands to empty? + #:datum-literals (empty?) ; note: null? expands to empty? (pattern (#%deforestable empty? _info))) (define-syntax-class fsc-default From 61f6561d95d1e4600737ccdb333bee492f54e165 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sat, 30 Nov 2024 04:24:52 -0700 Subject: [PATCH 084/108] Improve error message when a form is used as an identifier E.g. `filter` is a syntax error but `car` isn't. This ensures that the former provides a helpful error message (syntax-parse's default for the latter is already fine). --- qi-lib/macro.rkt | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index d2d3e4618..e9601cb93 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -125,13 +125,18 @@ #:fail-unless (= (length (attribute e)) (length (attribute arg-name))) "Wrong number of arguments!" - #`(#%deforestable #,name #,info [tag e] ...)])] - ;; TODO, check: instead of `car`, does `(car)` produce - ;; a useful syntax error? - ;; TODO: can add complementary error clauses in these two - ;; patterns; test that default errors are good enough. But if not - ;; can add the error clauses. - [op (syntax-parser [_:id #`(#%deforestable #,name #,info)])]))) + #`(#%deforestable #,name #,info [tag e] ...)] + [_:id + (raise-syntax-error #f + (format "Bad syntax. Usage: (~a arg ...)" + (syntax->datum this-syntax)) + this-syntax)])] + [op + (syntax-parser + ;; already raises a good error if used as a + ;; form with arguments (rather than as an identifier) + ;; so no special error handling needed here + [_:id #`(#%deforestable #,name #,info)])]))) (define-syntax define-deforestable (syntax-parser From 186841d45b03cea70b7044052d42c5e89aec1dc4 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 28 Jun 2024 17:39:40 -0700 Subject: [PATCH 085/108] =?UTF-8?q?Support=20`lambda`=20(and=20`=CE=BB`)?= =?UTF-8?q?=20as=20a=20core=20form?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This provides a shortcut to what may be the most common use of `esc` in the surface language, viz. `(esc (λ ...))`. The change was discussed in a recent meeting on "Designing List Operations": https://github.com/drym-org/qi/wiki/Qi-Meeting-Jun-21-2024#a-better-remedy --- qi-lib/flow/extended/expander.rkt | 4 ++++ qi-test/tests/flow.rkt | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index c40d1ae1c..7206ade51 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -182,6 +182,10 @@ core language's use of #%app, etc.). clos (clos onex:closed-floe) (esc ex:racket-expr) + (~> ((~literal lambda) e ...) + #'(esc (lambda e ...))) + (~> ((~literal λ) e ...) + #'(lambda e ...)) ;; core form to express deforestable operations (#%deforestable name:id info:id e:deforestable-clause ...) diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index f7e765380..46ed1e410 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -285,6 +285,11 @@ (check-equal? ((☯ (esc (first (list + *)))) 3 7) 10 "normal racket expressions")) + (test-suite + "lambda escape shortcut" + (check-equal? ((☯ (lambda (v) v)) 3) 3) + (check-equal? ((☯ (λ (v) v)) 3) 3) + (check-equal? ((☯ (λ () 3))) 3)) (test-suite "elementary boolean gates" (test-suite From 0c504f2f1abc19ce0bf77bf12b5aee2a7275c7e2 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 28 Jun 2024 17:47:44 -0700 Subject: [PATCH 086/108] Remove unused utility --- qi-lib/flow/core/private/form-property.rkt | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/qi-lib/flow/core/private/form-property.rkt b/qi-lib/flow/core/private/form-property.rkt index 035e4eb7e..c8aba01cf 100644 --- a/qi-lib/flow/core/private/form-property.rkt +++ b/qi-lib/flow/core/private/form-property.rkt @@ -18,8 +18,7 @@ (provide form-position? attach-form-property - tag-form-syntax - get-form-property) + tag-form-syntax) (require (only-in racket/function curry)) @@ -43,9 +42,6 @@ (define (attach-form-property stx) (syntax-property stx 'nonterminal 'floe)) -(define (get-form-property stx) - (syntax-property stx 'nonterminal)) - ;; This traverses a syntax object and indiscriminately tags every node ;; as a form. If this operation were applied to syntax in the real ;; compiler, it would of course lead to the incorrect optimizations we From 72f8031f3feb8d39aeac86a9d0243e518dddb59f Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 18:43:31 -0700 Subject: [PATCH 087/108] doc: the new `lambda` form --- qi-doc/scribblings/forms.scrbl | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/qi-doc/scribblings/forms.scrbl b/qi-doc/scribblings/forms.scrbl index 6e6098fdc..a74af067d 100644 --- a/qi-doc/scribblings/forms.scrbl +++ b/qi-doc/scribblings/forms.scrbl @@ -100,6 +100,20 @@ The core syntax of the Qi language. These forms may be used in any @tech{flow}. ] } +@deftogether[( + @defform[(lambda expr ...)] + @defform[(λ expr ...)] +)]{ + Shorthand for @racket[(esc (lambda ...))]. + +That is, this lambda is a @emph{Qi} form that expands to a use of @emph{Racket}'s lambda form, providing a shorthand for a common way to describe a flow using Racket. + +@examples[ + #:eval eval-for-docs + ((☯ (λ (x) (+ 2 x))) 3) + ] +} + @defform[(clos flo)]{ A @tech{flow} that generates a flow as a value. Any inputs to the @racket[clos] flow are available to @racket[flo] when it is applied to inputs, i.e. it is analogous to a @hyperlink["https://www.gnu.org/software/guile/manual/html_node/Closure.html"]{closure} in Racket. From ccb54b4eb5a5be04771a08eceb44026db9adf8df Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Tue, 17 Dec 2024 13:35:10 -0700 Subject: [PATCH 088/108] formally document the syntax The syntax of the full Qi language and the core language as grammars. Introduce and use the `floe` nonterminal in a few relevant spots in the docs. --- qi-doc/scribblings/forms.scrbl | 150 +++++++++++++++++++++++++- qi-doc/scribblings/interface.scrbl | 162 +++------------------------- qi-doc/scribblings/principles.scrbl | 74 ++++++++++++- 3 files changed, 234 insertions(+), 152 deletions(-) diff --git a/qi-doc/scribblings/forms.scrbl b/qi-doc/scribblings/forms.scrbl index a74af067d..5d5eb59ee 100644 --- a/qi-doc/scribblings/forms.scrbl +++ b/qi-doc/scribblings/forms.scrbl @@ -14,10 +14,152 @@ @title[#:tag "Qi_Forms"]{The Qi Language} -The core syntax of the Qi language. These forms may be used in any @tech{flow}. Flows may be specified in Racket via the @seclink["Language_Interface"]{language interface}. +The syntax and semantics of the Qi language. Qi @tech{flows} may be described using these forms and @seclink["Embedding_a_Hosted_Language"]{embedded} into Racket using the @seclink["Language_Interface"]{language interface}. @table-of-contents[] +@section{Syntax} + +The syntax of a language is most economically and clearly expressed using a grammar, in the form of "nonterminal" symbols along with production rules expressing the syntax that is entailed in positions marked by those symbols. We may thus take the single starting symbol in such a grammar to formally designate the entire syntax of the language. + +The symbol @racket[expr] is typically used in this sense to indicate a Racket nonterminal position in the syntax -- that is, a position that expects a Racket expression. Analogously, we use the identifier @deftech{@racket[floe]} (pronounced "flow-e," for "flow expression") to refer to the Qi nonterminal, i.e. a position expecting Qi syntax. + +The full syntax of Qi ("Standard Qi") is given below. Note that Standard Qi expands to a @seclink["The_Qi_Core_Language"]{smaller core language} before being @seclink["It_s_Languages_All_the_Way_Down"]{compiled to Racket}. + +@racketgrammar*[ +[floe _ + (gen expr ...) + △ + sep + ▽ + collect + (esc expr) + (clos floe) + (as identifier ...) + (one-of? expr ...) + (all floe) + (any floe) + (none floe) + (and floe ...) + (or floe ...) + (not floe) + (and% floe ...) + (or% floe ...) + NOT + ! + AND + & + OR + ∥ + NOR + NAND + XOR + XNOR + any? + all? + none? + inverter + ⏚ + ground + (~> floe ...) + (thread floe ...) + (~>> floe ...) + (thread-right floe ...) + X + crossover + == + (== floe ...) + relay + (relay floe ...) + (==* floe ...) + (relay* floe ...) + -< + (-< floe ...) + tee + (tee floe ...) + fanout + (fanout nat) + feedback + (feedback nat floe) + (feedback nat (then floe) floe) + (feedback (while floe) floe) + (feedback (while floe) (then floe) floe) + count + 1> + 2> + 3> + 4> + 5> + 6> + 7> + 8> + 9> + (select index ...) + (block index ...) + (bundle (index ...) floe floe) + group + (group nat floe floe) + sieve + (sieve floe floe floe) + (partition [floe floe] ...) + (if floe floe) + (if floe floe floe) + (when floe floe) + (unless floe floe) + switch + (switch switch-expr ...) + (switch (% floe) switch-expr ...) + (switch (divert floe) switch-expr ...) + (gate floe) + >< + (>< floe) + amp + (amp floe) + pass + (pass floe) + << + (<< floe) + (<< floe floe) + >> + (>> floe) + (>> floe floe) + (loop floe) + (loop floe floe) + (loop floe floe floe) + (loop floe floe floe floe) + (loop2 floe floe floe) + (ε floe floe) + (effect floe floe) + apply + (qi:* expr ...) + (expr expr ... __ expr ...) + (expr expr ... _ expr ...) + (expr expr ...) + literal + identifier] +[literal boolean + char + string + bytes + number + regexp + byte-regexp + vector-literal + box-literal + prefab-literal + (@#,racket[quote] value) + (quasiquote value) + (quote-syntax value) + (syntax value)] +[expr a-racket-expression] +[index exact-positive-integer?] +[nat exact-nonnegative-integer?] +[switch-expr [floe floe] + [floe (=> floe)] + [else floe]] +[identifier a-racket-identifier] +[value a-racket-value]] + @section{Basic} @defidform[_]{ @@ -528,9 +670,9 @@ A form of generalized @racket[sieve], passing all the inputs that satisfy each [(switch maybe-divert-expr switch-expr ...)] ([maybe-divert-expr (divert condition-gate-flow consequent-gate-flow) (% condition-gate-flow consequent-gate-flow)] - [switch-expr [flow-expr flow-expr] - [flow-expr (=> flow-expr)] - [else flow-expr]])]{ + [switch-expr [floe floe] + [floe (=> floe)] + [else floe]])]{ The @tech{flow} analogue of @racket[cond], this is a dispatcher where the condition and consequent expressions are all flows which operate on the switch inputs. Typically, each of the component flows -- conditions and consequents both -- receives all of the original inputs to the @racket[switch]. This can be changed by using a @racket[divert] clause, which takes two flow arguments, the first of whose outputs go to all of the condition flows, and the second of whose outputs go to all of the consequent flows. This can be useful in cases where multiple values flow, but only some of them are predicated upon, and others (or all of them) inform the actions to be taken. Using @racket[(divert _ _)] is equivalent to not using it. @racket[%] is a symbolic alias for @racket[divert] -- parse it visually not as the percentage sign, but as a convenient way to depict a "floodgate" diverting values down different channels. diff --git a/qi-doc/scribblings/interface.scrbl b/qi-doc/scribblings/interface.scrbl index be044a18e..6ef4ddf87 100644 --- a/qi-doc/scribblings/interface.scrbl +++ b/qi-doc/scribblings/interface.scrbl @@ -22,140 +22,8 @@ The core entry-point to Qi from the host language is the form @racket[☯]. In a @subsection{Core} @deftogether[( -@defform*/subs[[(☯ flow-expr)] - ([flow-expr (code:line) - _ - (gen expr ...) - △ - sep - ▽ - collect - (esc expr) - (clos flow-expr) - (as identifier ...) - (one-of? expr ...) - (all flow-expr) - (any flow-expr) - (none flow-expr) - (and flow-expr ...) - (or flow-expr ...) - (not flow-expr) - (and% flow-expr ...) - (or% flow-expr ...) - NOT - ! - AND - & - OR - ∥ - NOR - NAND - XOR - XNOR - any? - all? - none? - inverter - ⏚ - ground - (~> flow-expr ...) - (thread flow-expr ...) - (~>> flow-expr ...) - (thread-right flow-expr ...) - X - crossover - == - (== flow-expr ...) - relay - (relay flow-expr ...) - (==* flow-expr ...) - (relay* flow-expr ...) - -< - (-< flow-expr ...) - tee - (tee flow-expr ...) - fanout - (fanout nat) - feedback - (feedback nat flow-expr) - (feedback nat (then flow-expr) flow-expr) - (feedback (while flow-expr) flow-expr) - (feedback (while flow-expr) (then flow-expr) flow-expr) - count - 1> - 2> - 3> - 4> - 5> - 6> - 7> - 8> - 9> - (select index ...) - (block index ...) - (bundle (index ...) flow-expr flow-expr) - (group nat flow-expr flow-expr) - sieve - (sieve flow-expr flow-expr flow-expr) - (partition [flow-expr flow-expr] ...) - (if flow-expr flow-expr) - (if flow-expr flow-expr flow-expr) - (when flow-expr flow-expr) - (unless flow-expr flow-expr) - switch - (switch switch-expr ...) - (switch (% flow-expr) switch-expr ...) - (switch (divert flow-expr) switch-expr ...) - (gate flow-expr) - >< - (>< flow-expr) - amp - (amp flow-expr) - pass - (pass flow-expr) - << - (<< flow-expr) - (<< flow-expr flow-expr) - >> - (>> flow-expr) - (>> flow-expr flow-expr) - (loop flow-expr) - (loop flow-expr flow-expr) - (loop flow-expr flow-expr flow-expr) - (loop flow-expr flow-expr flow-expr flow-expr) - (loop2 flow-expr flow-expr flow-expr) - (ε flow-expr flow-expr) - (effect flow-expr flow-expr) - apply - (qi:* expr ...) - (expr expr ... __ expr ...) - (expr expr ... _ expr ...) - (expr expr ...) - literal - identifier] - [literal boolean - char - string - bytes - number - regexp - byte-regexp - vector-literal - box-literal - prefab-literal - (quote value) - (quasiquote value) - (quote-syntax value) - (syntax value)] - [expr a-racket-expression] - [index exact-positive-integer?] - [nat exact-nonnegative-integer?] - [switch-expr [flow-expr flow-expr] - [flow-expr (=> flow-expr)] - [else flow-expr]] - [identifier a-racket-identifier] - [value a-racket-value])] - @defform[(flow flow-expr)] + @defform[(☯ @#,seclink["Syntax"]{@racket[floe]})] + @defform[(flow @#,seclink["Syntax"]{@racket[floe]})] )]{ Define a @tech{flow} by using the various @seclink["Qi_Forms"]{forms} of the Qi language. @@ -173,14 +41,14 @@ See @secref["Flowing_with_the_Flow"] for ways to enter the @racket[☯] symbol i ] } -@defform[(on (arg ...) flow-expr)]{ +@defform[(on (arg ...) @#,seclink["Syntax"]{@racket[floe]})]{ Define and execute a @tech{flow} with the inputs named in advance. This is a way to pass inputs to a flow that is an alternative to the usual function invocation syntax (i.e. an alternative to simply invoking the flow with arguments). It may be preferable in certain cases, since the inputs are named at the beginning rather than at the end. In the respect that it both defines as well as invokes the flow, it has the same relationship to @racket[☯] as @racket[let] has to @racket[lambda], and can be used in analogous ways. - Equivalent to @racket[((☯ flow-expr) arg ...)]. + Equivalent to @racket[((☯ @#,seclink["Syntax"]{@racket[floe]}) arg ...)]. @examples[ #:eval eval-for-docs @@ -194,8 +62,8 @@ See @secref["Flowing_with_the_Flow"] for ways to enter the @racket[☯] symbol i @subsection{Threading} @deftogether[( -@defform[(~> (args ...) flow-expr ...)] -@defform[(~>> (args ...) flow-expr ...)] +@defform[(~> (args ...) @#,seclink["Syntax"]{@racket[floe]} ...)] +@defform[(~>> (args ...) @#,seclink["Syntax"]{@racket[floe]} ...)] )]{ These @emph{Racket} forms leverage the identically-named @emph{Qi} forms to thread inputs through a sequence of @tech{flows}. @racket[~>] threads arguments in the first position by default, while @racket[~>>] uses the last position, but in either case the positions can instead be explicitly indicated by using @racket[_] or @racket[___]. @@ -207,7 +75,7 @@ See @secref["Flowing_with_the_Flow"] for ways to enter the @racket[☯] symbol i In the respect that these both define as well as invoke the flow, they have the same relationship to @racket[☯] as @racket[let] has to @racket[lambda], and can be used in analogous ways. - Equivalent to @racket[((☯ (~> flow-expr ...)) args ...)]. + Equivalent to @racket[((☯ (~> @#,seclink["Syntax"]{@racket[floe]} ...)) args ...)]. See also: @secref["Relationship_to_the_Threading_Macro"]. @@ -250,11 +118,11 @@ Each of the @racket[predicate] and @racket[consequent] expressions is a @tech{fl These anonymous function forms may be used in cases where you need to explicitly @emph{name} the arguments for some reason. Otherwise, in most cases, just use @racket[☯] directly instead as it produces a function while avoiding the extraneous layer of bindings. @deftogether[( - @defform[(flow-lambda args flow-expr)] - @defform[(flow-λ args flow-expr)] - @defform[(π args flow-expr)] + @defform[(flow-lambda args @#,seclink["Syntax"]{@racket[floe]})] + @defform[(flow-λ args @#,seclink["Syntax"]{@racket[floe]})] + @defform[(π args @#,seclink["Syntax"]{@racket[floe]})] )]{ - Similiar to @racket[lambda] but constrained to the flow language. This is exactly equivalent to @racket[(lambda args (on (args) flow-expr))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @racket[flow-expr]. @racket[flow-λ] and @racket[π] are aliases for @racket[flow-lambda]. The present form mainly finds its use internally in @racket[define-flow], and in most cases you should use @racket[☯] directly. + Similiar to @racket[lambda] but constrained to the flow language. This is exactly equivalent to @racket[(lambda args (on (args) @#,seclink["Syntax"]{@racket[floe]}))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @seclink["Syntax"]{@racket[floe]}. @racket[flow-λ] and @racket[π] are aliases for @racket[flow-lambda]. The present form mainly finds its use internally in @racket[define-flow], and in most cases you should use @racket[☯] directly. @examples[ #:eval eval-for-docs @@ -284,7 +152,7 @@ Each of the @racket[predicate] and @racket[consequent] expressions is a @tech{fl ... [else consequent ...])] )]{ - Similar to @racket[lambda] but constrained to be a flow-based dispatcher. This is exactly equivalent to @racket[(lambda args (switch (args) maybe-divert-clause [predicate consequent ...] ... [else consequent ...]))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @racket[flow-expr]. @racket[switch-λ] and @racket[λ01] are aliases for @racket[switch-lambda]. + Similar to @racket[lambda] but constrained to be a flow-based dispatcher. This is exactly equivalent to @racket[(lambda args (switch (args) maybe-divert-clause [predicate consequent ...] ... [else consequent ...]))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @seclink["Syntax"]{@racket[floe]}. @racket[switch-λ] and @racket[λ01] are aliases for @racket[switch-lambda]. @examples[ #:eval eval-for-docs @@ -305,10 +173,10 @@ Each of the @racket[predicate] and @racket[consequent] expressions is a @tech{fl The following definition forms may be used in place of the usual general-purpose @racket[define] form when defining @tech{flows}. @deftogether[( - @defform[(define-flow name flow-expr)] + @defform[(define-flow name @#,seclink["Syntax"]{@racket[floe]})] @defform[#:link-target? #f - (define-flow (head args) flow-expr)])]{ - Similiar to the function form of @racket[define] but constrained to the flow language. This is exactly equivalent to @racket[(define head (flow-lambda args flow-expr))]. + (define-flow (head args) @#,seclink["Syntax"]{@racket[floe]})])]{ + Similiar to the function form of @racket[define] but constrained to the flow language. This is exactly equivalent to @racket[(define head (flow-lambda args @#,seclink["Syntax"]{@racket[floe]}))]. } @deftogether[( diff --git a/qi-doc/scribblings/principles.scrbl b/qi-doc/scribblings/principles.scrbl index 37b6f56a5..694d8a2e2 100644 --- a/qi-doc/scribblings/principles.scrbl +++ b/qi-doc/scribblings/principles.scrbl @@ -134,7 +134,7 @@ Qi is a language implemented on top of another language, Racket, by means of a m The @racket[flow] form accepts Qi syntax and (like any @tech/reference{macro}) produces Racket syntax. It does this in two stages: @itemlist[#:style 'ordered - @item{Expansion, where the Qi source expression is translated to a small core language (Core Qi).} + @item{Expansion, where the Qi source expression is translated to a small core language (@seclink["The_Qi_Core_Language"]{Core Qi}).} @item{Compilation, where the Core Qi expression is optimized and then translated into Racket.} ] @@ -143,3 +143,75 @@ All of this happens at @seclink["phases" #:doc '(lib "scribblings/guide/guide.sc Thus, Qi is a special kind of @seclink["Hosted_Languages"]{hosted language}, one that happens to have the same architecture as the host language, Racket, in terms of having distinct expansion and compilation steps. This gives it a lot of flexibility in its implementation, including allowing much of its surface syntax to be implemented as @seclink["Qi_Macros"]{Qi macros} (for instance, Qi's @racket[switch] expands to a use of Qi's @racket[if] just as Racket's @racket[cond] expands to a use of Racket's @racket[if]), allowing it to be naturally macro-extensible by users, and lending it the ability to @seclink["Don_t_Stop_Me_Now"]{perform optimizations on the core language} that allow idiomatic code to be performant. This architecture is achieved through the use of @seclink["top" #:indirect? #t #:doc '(lib "syntax-spec-v2/scribblings/main.scrbl")]{Syntax Spec}, following the general approach described in @hyperlink["https://dl.acm.org/doi/abs/10.1145/3674627"]{Compiled, Extensible, Multi-language DSLs (Ballantyne et. al.)} and @hyperlink["https://dl.acm.org/doi/abs/10.1145/3428297"]{Macros for Domain-Specific Languages (Ballantyne et. al.)}. + +@section{The Qi Core Language} + +Qi flow expressions expand to a small core language which is then @seclink["It_s_Languages_All_the_Way_Down"]{optimized and compiled to Racket}. The core language specification is given below. This syntax is a sub-language of the @seclink["Syntax"]{full Qi language}. + +@racketgrammar*[ +[floe _ + (gen expr ...) + sep + collect + (esc expr) + (clos floe) + (as identifier ...) + (all floe) + (any floe) + (none floe) + (and floe ...) + (or floe ...) + (not floe) + NOT + ! + XOR + ⏚ + ground + (thread floe ...) + relay + (relay floe ...) + tee + (tee floe ...) + fanout + (fanout nat) + feedback + (feedback nat floe) + (feedback nat (then floe) floe) + (feedback (while floe) floe) + (feedback (while floe) (then floe) floe) + (select index ...) + (block index ...) + group + (group nat floe floe) + sieve + (sieve floe floe floe) + (partition [floe floe] ...) + (if floe floe) + (if floe floe floe) + amp + (amp floe) + pass + (pass floe) + << + (<< floe) + (<< floe floe) + >> + (>> floe) + (>> floe floe) + (loop floe) + (loop floe floe) + (loop floe floe floe) + (loop floe floe floe floe) + (loop2 floe floe floe) + appleye + (qi:* expr ...) + (#%blanket-template (expr expr ... __ expr ...)) + (#%fine-template (expr expr ... _ expr ...)) + (#%partial-application-form (expr expr ...)) + (#%deforestable identifier identifier deforestable-clause ...)] +[deforestable-clause (f floe) + (e expr)] +[expr a-racket-expression] +[index exact-positive-integer?] +[nat exact-nonnegative-integer?] +[identifier a-racket-identifier]] From 9e7f781ef26b6f955035dae35ec28e566c06c887 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Tue, 17 Dec 2024 13:52:43 -0700 Subject: [PATCH 089/108] distinguish core and macro forms in full syntax Also link to the core language grammar instead of duplicating it --- qi-doc/scribblings/forms.scrbl | 168 ++++++++++------------------ qi-doc/scribblings/principles.scrbl | 1 - 2 files changed, 58 insertions(+), 111 deletions(-) diff --git a/qi-doc/scribblings/forms.scrbl b/qi-doc/scribblings/forms.scrbl index 5d5eb59ee..8de3b16ba 100644 --- a/qi-doc/scribblings/forms.scrbl +++ b/qi-doc/scribblings/forms.scrbl @@ -27,116 +27,64 @@ The symbol @racket[expr] is typically used in this sense to indicate a Racket no The full syntax of Qi ("Standard Qi") is given below. Note that Standard Qi expands to a @seclink["The_Qi_Core_Language"]{smaller core language} before being @seclink["It_s_Languages_All_the_Way_Down"]{compiled to Racket}. @racketgrammar*[ -[floe _ - (gen expr ...) - △ - sep - ▽ - collect - (esc expr) - (clos floe) - (as identifier ...) - (one-of? expr ...) - (all floe) - (any floe) - (none floe) - (and floe ...) - (or floe ...) - (not floe) - (and% floe ...) - (or% floe ...) - NOT - ! - AND - & - OR - ∥ - NOR - NAND - XOR - XNOR - any? - all? - none? - inverter - ⏚ - ground - (~> floe ...) - (thread floe ...) - (~>> floe ...) - (thread-right floe ...) - X - crossover - == - (== floe ...) - relay - (relay floe ...) - (==* floe ...) - (relay* floe ...) - -< - (-< floe ...) - tee - (tee floe ...) - fanout - (fanout nat) - feedback - (feedback nat floe) - (feedback nat (then floe) floe) - (feedback (while floe) floe) - (feedback (while floe) (then floe) floe) - count - 1> - 2> - 3> - 4> - 5> - 6> - 7> - 8> - 9> - (select index ...) - (block index ...) - (bundle (index ...) floe floe) - group - (group nat floe floe) - sieve - (sieve floe floe floe) - (partition [floe floe] ...) - (if floe floe) - (if floe floe floe) - (when floe floe) - (unless floe floe) - switch - (switch switch-expr ...) - (switch (% floe) switch-expr ...) - (switch (divert floe) switch-expr ...) - (gate floe) - >< - (>< floe) - amp - (amp floe) - pass - (pass floe) - << - (<< floe) - (<< floe floe) - >> - (>> floe) - (>> floe floe) - (loop floe) - (loop floe floe) - (loop floe floe floe) - (loop floe floe floe floe) - (loop2 floe floe floe) - (ε floe floe) - (effect floe floe) - apply - (qi:* expr ...) - (expr expr ... __ expr ...) - (expr expr ... _ expr ...) - (expr expr ...) - literal - identifier] +[floe @#,seclink["The_Qi_Core_Language"]{core-form} + macro-form] +[macro-form △ + ▽ + (one-of? expr ...) + (and% floe ...) + (or% floe ...) + AND + & + OR + ∥ + NOR + NAND + XNOR + any? + all? + none? + inverter + ⏚ + (~> floe ...) + (~>> floe ...) + (thread-right floe ...) + X + crossover + == + (== floe ...) + (==* floe ...) + (relay* floe ...) + -< + (-< floe ...) + count + 1> + 2> + 3> + 4> + 5> + 6> + 7> + 8> + 9> + (bundle (index ...) floe floe) + (when floe floe) + (unless floe floe) + switch + (switch switch-expr ...) + (switch (% floe) switch-expr ...) + (switch (divert floe) switch-expr ...) + (gate floe) + >< + (>< floe) + (ε floe floe) + (effect floe floe) + apply + (expr expr ... __ expr ...) + (expr expr ... _ expr ...) + (expr expr ...) + literal + identifier] [literal boolean char string diff --git a/qi-doc/scribblings/principles.scrbl b/qi-doc/scribblings/principles.scrbl index 694d8a2e2..c9b730e52 100644 --- a/qi-doc/scribblings/principles.scrbl +++ b/qi-doc/scribblings/principles.scrbl @@ -165,7 +165,6 @@ Qi flow expressions expand to a small core language which is then @seclink["It_s NOT ! XOR - ⏚ ground (thread floe ...) relay From d6d43aab8395c4b1669d19091f295bc5cce51c31 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Tue, 17 Dec 2024 16:59:05 -0700 Subject: [PATCH 090/108] link `floe` to the tech definition instead of the containing section --- qi-doc/scribblings/interface.scrbl | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/qi-doc/scribblings/interface.scrbl b/qi-doc/scribblings/interface.scrbl index 6ef4ddf87..20531b357 100644 --- a/qi-doc/scribblings/interface.scrbl +++ b/qi-doc/scribblings/interface.scrbl @@ -22,8 +22,8 @@ The core entry-point to Qi from the host language is the form @racket[☯]. In a @subsection{Core} @deftogether[( - @defform[(☯ @#,seclink["Syntax"]{@racket[floe]})] - @defform[(flow @#,seclink["Syntax"]{@racket[floe]})] + @defform[(☯ @#,tech{floe})] + @defform[(flow @#,tech{floe})] )]{ Define a @tech{flow} by using the various @seclink["Qi_Forms"]{forms} of the Qi language. @@ -41,14 +41,14 @@ See @secref["Flowing_with_the_Flow"] for ways to enter the @racket[☯] symbol i ] } -@defform[(on (arg ...) @#,seclink["Syntax"]{@racket[floe]})]{ +@defform[(on (arg ...) @#,tech{floe})]{ Define and execute a @tech{flow} with the inputs named in advance. This is a way to pass inputs to a flow that is an alternative to the usual function invocation syntax (i.e. an alternative to simply invoking the flow with arguments). It may be preferable in certain cases, since the inputs are named at the beginning rather than at the end. In the respect that it both defines as well as invokes the flow, it has the same relationship to @racket[☯] as @racket[let] has to @racket[lambda], and can be used in analogous ways. - Equivalent to @racket[((☯ @#,seclink["Syntax"]{@racket[floe]}) arg ...)]. + Equivalent to @racket[((☯ @#,tech{floe}) arg ...)]. @examples[ #:eval eval-for-docs @@ -62,8 +62,8 @@ See @secref["Flowing_with_the_Flow"] for ways to enter the @racket[☯] symbol i @subsection{Threading} @deftogether[( -@defform[(~> (args ...) @#,seclink["Syntax"]{@racket[floe]} ...)] -@defform[(~>> (args ...) @#,seclink["Syntax"]{@racket[floe]} ...)] +@defform[(~> (args ...) @#,tech{floe} ...)] +@defform[(~>> (args ...) @#,tech{floe} ...)] )]{ These @emph{Racket} forms leverage the identically-named @emph{Qi} forms to thread inputs through a sequence of @tech{flows}. @racket[~>] threads arguments in the first position by default, while @racket[~>>] uses the last position, but in either case the positions can instead be explicitly indicated by using @racket[_] or @racket[___]. @@ -75,7 +75,7 @@ See @secref["Flowing_with_the_Flow"] for ways to enter the @racket[☯] symbol i In the respect that these both define as well as invoke the flow, they have the same relationship to @racket[☯] as @racket[let] has to @racket[lambda], and can be used in analogous ways. - Equivalent to @racket[((☯ (~> @#,seclink["Syntax"]{@racket[floe]} ...)) args ...)]. + Equivalent to @racket[((☯ (~> @#,tech{floe} ...)) args ...)]. See also: @secref["Relationship_to_the_Threading_Macro"]. @@ -118,11 +118,11 @@ Each of the @racket[predicate] and @racket[consequent] expressions is a @tech{fl These anonymous function forms may be used in cases where you need to explicitly @emph{name} the arguments for some reason. Otherwise, in most cases, just use @racket[☯] directly instead as it produces a function while avoiding the extraneous layer of bindings. @deftogether[( - @defform[(flow-lambda args @#,seclink["Syntax"]{@racket[floe]})] - @defform[(flow-λ args @#,seclink["Syntax"]{@racket[floe]})] - @defform[(π args @#,seclink["Syntax"]{@racket[floe]})] + @defform[(flow-lambda args @#,tech{floe})] + @defform[(flow-λ args @#,tech{floe})] + @defform[(π args @#,tech{floe})] )]{ - Similiar to @racket[lambda] but constrained to the flow language. This is exactly equivalent to @racket[(lambda args (on (args) @#,seclink["Syntax"]{@racket[floe]}))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @seclink["Syntax"]{@racket[floe]}. @racket[flow-λ] and @racket[π] are aliases for @racket[flow-lambda]. The present form mainly finds its use internally in @racket[define-flow], and in most cases you should use @racket[☯] directly. + Similiar to @racket[lambda] but constrained to the flow language. This is exactly equivalent to @racket[(lambda args (on (args) @#,tech{floe}))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @tech{floe}. @racket[flow-λ] and @racket[π] are aliases for @racket[flow-lambda]. The present form mainly finds its use internally in @racket[define-flow], and in most cases you should use @racket[☯] directly. @examples[ #:eval eval-for-docs @@ -152,7 +152,7 @@ Each of the @racket[predicate] and @racket[consequent] expressions is a @tech{fl ... [else consequent ...])] )]{ - Similar to @racket[lambda] but constrained to be a flow-based dispatcher. This is exactly equivalent to @racket[(lambda args (switch (args) maybe-divert-clause [predicate consequent ...] ... [else consequent ...]))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @seclink["Syntax"]{@racket[floe]}. @racket[switch-λ] and @racket[λ01] are aliases for @racket[switch-lambda]. + Similar to @racket[lambda] but constrained to be a flow-based dispatcher. This is exactly equivalent to @racket[(lambda args (switch (args) maybe-divert-clause [predicate consequent ...] ... [else consequent ...]))] except that the keywords only introduce bindings, and aren't part of the values that are fed into @tech{floe}. @racket[switch-λ] and @racket[λ01] are aliases for @racket[switch-lambda]. @examples[ #:eval eval-for-docs @@ -173,10 +173,10 @@ Each of the @racket[predicate] and @racket[consequent] expressions is a @tech{fl The following definition forms may be used in place of the usual general-purpose @racket[define] form when defining @tech{flows}. @deftogether[( - @defform[(define-flow name @#,seclink["Syntax"]{@racket[floe]})] + @defform[(define-flow name @#,tech{floe})] @defform[#:link-target? #f - (define-flow (head args) @#,seclink["Syntax"]{@racket[floe]})])]{ - Similiar to the function form of @racket[define] but constrained to the flow language. This is exactly equivalent to @racket[(define head (flow-lambda args @#,seclink["Syntax"]{@racket[floe]}))]. + (define-flow (head args) @#,tech{floe})])]{ + Similiar to the function form of @racket[define] but constrained to the flow language. This is exactly equivalent to @racket[(define head (flow-lambda args @#,tech{floe}))]. } @deftogether[( From 723352f42d5db2e959ba0e0897cfe60dcf38ed81 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 20 Dec 2024 13:59:51 -0700 Subject: [PATCH 091/108] update intro in qi/list docs Also add a grammar cataloguing the qi/list forms --- qi-doc/scribblings/forms.scrbl | 2 +- qi-doc/scribblings/list-operations.scrbl | 40 ++++++++++++++++++------ 2 files changed, 31 insertions(+), 11 deletions(-) diff --git a/qi-doc/scribblings/forms.scrbl b/qi-doc/scribblings/forms.scrbl index 8de3b16ba..9bb77b884 100644 --- a/qi-doc/scribblings/forms.scrbl +++ b/qi-doc/scribblings/forms.scrbl @@ -24,7 +24,7 @@ The syntax of a language is most economically and clearly expressed using a gram The symbol @racket[expr] is typically used in this sense to indicate a Racket nonterminal position in the syntax -- that is, a position that expects a Racket expression. Analogously, we use the identifier @deftech{@racket[floe]} (pronounced "flow-e," for "flow expression") to refer to the Qi nonterminal, i.e. a position expecting Qi syntax. -The full syntax of Qi ("Standard Qi") is given below. Note that Standard Qi expands to a @seclink["The_Qi_Core_Language"]{smaller core language} before being @seclink["It_s_Languages_All_the_Way_Down"]{compiled to Racket}. +The full surface syntax of Qi is given below. Note that this expands to a @seclink["The_Qi_Core_Language"]{smaller core language} before being @seclink["It_s_Languages_All_the_Way_Down"]{compiled to Racket}. It does not include the @seclink["List_Operations"]{list-oriented forms}, which may be added via @racket[(require qi/list)]. @racketgrammar*[ [floe @#,seclink["The_Qi_Core_Language"]{core-form} diff --git a/qi-doc/scribblings/list-operations.scrbl b/qi-doc/scribblings/list-operations.scrbl index 2b70c1181..2119ae7cb 100644 --- a/qi-doc/scribblings/list-operations.scrbl +++ b/qi-doc/scribblings/list-operations.scrbl @@ -1,20 +1,40 @@ #lang scribble/doc @require[scribble/manual - (for-label racket/list - racket/base)] + (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. +This module defines functional list operations analogous to those in +@racketmodname[racket/base] and @racketmodname[racket/list], except +that these forms support @tech{flows} in higher-order function +positions and leverage the @seclink["Don_t_Stop_Me_Now"]{stream fusion +/ deforestation} optimization to avoid constructing intermediate +representations along the way to computing the result. + +The forms in this module extend the syntax of the @seclink["The_Qi_Core_Language"]{core Qi language}. This extended syntax is given below: + +@racketgrammar*[ +[floe (map floe) + (filter floe) + (filter-map floe) + (foldl floe expr) + (foldr floe expr) + (range expr expr expr) + (take expr) + car + cadr + caddr + cadddr + (list-ref expr) + length + empty? + null?]] + +The operations are categorized based on their role in the deforested +pipeline. @section{Producers} From 7e94a65b9ce0776b8e151a4e99ee39114eda42e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 27 Dec 2024 16:38:45 +0100 Subject: [PATCH 092/108] Update list-operations scribblings. - change all defproc to appropriate defform/defidform - add #:contracts where still applicable --- qi-doc/scribblings/list-operations.scrbl | 67 +++++++++++++++++------- 1 file changed, 47 insertions(+), 20 deletions(-) diff --git a/qi-doc/scribblings/list-operations.scrbl b/qi-doc/scribblings/list-operations.scrbl index 2119ae7cb..5377f921e 100644 --- a/qi-doc/scribblings/list-operations.scrbl +++ b/qi-doc/scribblings/list-operations.scrbl @@ -38,35 +38,54 @@ pipeline. @section{Producers} -@defproc*[(((range (end real?)) list?) - ((range (start real?) (end real?) (step real? 1)) list?))]{ +@defform*[ + ((range end) + (range start end) + (range start end step)) + #:contracts + ((start real?) + (end real?) + (step real?))]{ Deforestable version of @racket[range] from @racketmodname[racket/list]. +By default @racket[start] is @racket[0] and @racket[step] is @racket[1]. + } @section{Transformers} -@defproc[(filter (pred procedure?) (lst list?)) list?]{ +@defform[ + (filter pred) + #:contracts + ((pred (-> any/c any/c)))]{ Deforestable version of @racket[filter] from @racketmodname[racket/base]. } -@defproc[(map (proc procedure?) (lst list?) ...+) list?]{ +@defform[ + (map proc) + #:contracts + ((proc (-> any/c any/c)))]{ Deforestable version of @racket[map] from @racketmodname[racket/base]. } -@defproc[(filter-map (proc procedure?) (lst list?) ...+) list?]{ +@defform[ + (filter-map proc) + #:contracts + ((proc (-> any/c any/c)))]{ 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?))]{ +@defform[ + (take pos) + #:contracts + ((pos exact-nonnegative-integer?))]{ Deforestable version of @racket[take] from @racketmodname[racket/list]. @@ -74,65 +93,73 @@ Deforestable version of @racket[take] from @racketmodname[racket/list]. @section{Consumers} -@defproc[(foldl (proc procedure?) (init any/c) (lst list?) ...+) any/c]{ +@defform[ + (foldl proc init) + #:contracts + ((proc (-> any/c any/c any/c any/c)) + (init any/c))]{ Deforestable version of @racket[foldl] from @racketmodname[racket/base]. } -@defproc[(foldr (proc procedure?) (init any/c) (lst list?) ...+) any/c]{ +@defform[ + (foldr proc init) + #:contracts + ((proc (-> any/c any/c any/c any/c)) + (init any/c))]{ Deforestable version of @racket[foldr] from @racketmodname[racket/base]. } -@defproc[(car (p pair?)) any/c]{ +@defidform[car]{ Deforestable version of @racket[car] from @racketmodname[racket/base]. } -@defproc[(cadr (v (cons/c any/c pair?))) any/c]{ +@defidform[cadr]{ Deforestable version of @racket[cadr] from @racketmodname[racket/base]. } -@defproc[(caddr (v (cons/c any/c (cons/c any/c pair?)))) any/c]{ +@defidform[caddr]{ 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]{ +@defidform[cadddr]{ 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))]{ +@defform[ + (list-ref pos) + #:contracts + ((pos exact-nonnegative-integer?))]{ Deforestable version of @racket[list-ref] from @racketmodname[racket/base]. } -@defproc[(length (lst list?)) exact-nonnegative-integer?]{ +@defidform[length]{ Deforestable version of @racket[length] from @racketmodname[racket/base]. } -@defproc[(empty? (v any/c)) boolean?]{ +@defidform[empty?]{ Deforestable version of @racket[empty?] from @racketmodname[racket/list]. } -@defproc[(null? (v any/c)) boolean?]{ +@defidform[null?]{ Deforestable version of @racket[null?] from @racketmodname[racket/base]. } - - From 62cdc19a99699def7e30a378ef3fc3f5e5416d2c Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 27 Dec 2024 16:33:41 -0700 Subject: [PATCH 093/108] address code review comments re: docs --- qi-doc/scribblings/forms.scrbl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/qi-doc/scribblings/forms.scrbl b/qi-doc/scribblings/forms.scrbl index 9bb77b884..41483ac1d 100644 --- a/qi-doc/scribblings/forms.scrbl +++ b/qi-doc/scribblings/forms.scrbl @@ -22,7 +22,7 @@ The syntax and semantics of the Qi language. Qi @tech{flows} may be described us The syntax of a language is most economically and clearly expressed using a grammar, in the form of "nonterminal" symbols along with production rules expressing the syntax that is entailed in positions marked by those symbols. We may thus take the single starting symbol in such a grammar to formally designate the entire syntax of the language. -The symbol @racket[expr] is typically used in this sense to indicate a Racket nonterminal position in the syntax -- that is, a position that expects a Racket expression. Analogously, we use the identifier @deftech{@racket[floe]} (pronounced "flow-e," for "flow expression") to refer to the Qi nonterminal, i.e. a position expecting Qi syntax. +The symbol @racket[expr] is typically used in this sense to indicate a Racket nonterminal position in the syntax, i.e., a position that expects a Racket expression. Analogously, we use the identifier @deftech{@racket[floe]} (pronounced "flow-e," for "flow expression") to refer to the Qi nonterminal, i.e., a position expecting Qi syntax. The full surface syntax of Qi is given below. Note that this expands to a @seclink["The_Qi_Core_Language"]{smaller core language} before being @seclink["It_s_Languages_All_the_Way_Down"]{compiled to Racket}. It does not include the @seclink["List_Operations"]{list-oriented forms}, which may be added via @racket[(require qi/list)]. @@ -96,9 +96,9 @@ The full surface syntax of Qi is given below. Note that this expands to a @secli box-literal prefab-literal (@#,racket[quote] value) - (quasiquote value) - (quote-syntax value) - (syntax value)] + (@#,racket[quasiquote] value) + (@#,racket[quote-syntax] value) + (@#,racket[syntax] value)] [expr a-racket-expression] [index exact-positive-integer?] [nat exact-nonnegative-integer?] From 8b716244f2eac51e7f7d44e51479af528647ec7e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 27 Dec 2024 17:34:09 -0700 Subject: [PATCH 094/108] doc: distinguish `floe` from `flow` And elaborate a bit more in places where it was terse. --- qi-doc/scribblings/forms.scrbl | 2 ++ qi-doc/scribblings/principles.scrbl | 6 +++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/qi-doc/scribblings/forms.scrbl b/qi-doc/scribblings/forms.scrbl index 41483ac1d..e22e864b6 100644 --- a/qi-doc/scribblings/forms.scrbl +++ b/qi-doc/scribblings/forms.scrbl @@ -24,6 +24,8 @@ The syntax of a language is most economically and clearly expressed using a gram The symbol @racket[expr] is typically used in this sense to indicate a Racket nonterminal position in the syntax, i.e., a position that expects a Racket expression. Analogously, we use the identifier @deftech{@racket[floe]} (pronounced "flow-e," for "flow expression") to refer to the Qi nonterminal, i.e., a position expecting Qi syntax. +@tech{floe} is not to be confused with @tech{flow}. The relationship between the two is one of syntax and semantics, that is, the meaning of a @tech{floe} is a @tech{flow}. + The full surface syntax of Qi is given below. Note that this expands to a @seclink["The_Qi_Core_Language"]{smaller core language} before being @seclink["It_s_Languages_All_the_Way_Down"]{compiled to Racket}. It does not include the @seclink["List_Operations"]{list-oriented forms}, which may be added via @racket[(require qi/list)]. @racketgrammar*[ diff --git a/qi-doc/scribblings/principles.scrbl b/qi-doc/scribblings/principles.scrbl index c9b730e52..b4ec1dfc7 100644 --- a/qi-doc/scribblings/principles.scrbl +++ b/qi-doc/scribblings/principles.scrbl @@ -19,11 +19,11 @@ @section{What is a Flow?} - A @deftech{flow} is either made up of flows, or is a native (e.g. Racket) @seclink["lambda" #:doc '(lib "scribblings/guide/guide.scrbl")]{function}. Flows may be composed using a number of combinators that could yield either linear or nonlinear composite flows. + A @deftech{flow} is either composed of flows, or is a native (e.g. Racket) @seclink["lambda" #:doc '(lib "scribblings/guide/guide.scrbl")]{function}. In the former case, the composite flow is made up of flows that are combined in @seclink["Qi_Forms"]{well-defined structural ways} specifying the role of each component flow. A flow in general accepts @code{m} inputs and yields @code{n} outputs, for arbitrary non-negative integers @code{m} and @code{n}. We say that such a flow is @code{m × n}. - The semantics of a flow is function invocation -- simply invoke a flow with inputs (i.e. ordinary arguments) to obtain the outputs. + Flows are @seclink["Embedding_a_Hosted_Language"]{embedded} into the host language (e.g. Racket) using the @racket[☯] macro which evaluates to an ordinary function. To use the flow, simply invoke this function with inputs as ordinary arguments to obtain the outputs as ordinary return values. The Qi language allows you to describe and use flows in your code. @@ -146,7 +146,7 @@ This architecture is achieved through the use of @seclink["top" #:indirect? #t # @section{The Qi Core Language} -Qi flow expressions expand to a small core language which is then @seclink["It_s_Languages_All_the_Way_Down"]{optimized and compiled to Racket}. The core language specification is given below. This syntax is a sub-language of the @seclink["Syntax"]{full Qi language}. +Qi flow expressions expand to a small core language which is then @seclink["It_s_Languages_All_the_Way_Down"]{optimized and compiled to Racket}. The core language specification is given below. This syntax is a subset of the @seclink["Syntax"]{full Qi language}. @racketgrammar*[ [floe _ From 9dff1ae093acba16f2e6771a86d5846e01d66072 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 27 Dec 2024 17:40:58 -0700 Subject: [PATCH 095/108] cr: add `range` syntax variants that were missing --- qi-doc/scribblings/list-operations.scrbl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/qi-doc/scribblings/list-operations.scrbl b/qi-doc/scribblings/list-operations.scrbl index 5377f921e..36e1b0a7b 100644 --- a/qi-doc/scribblings/list-operations.scrbl +++ b/qi-doc/scribblings/list-operations.scrbl @@ -14,7 +14,9 @@ positions and leverage the @seclink["Don_t_Stop_Me_Now"]{stream fusion / deforestation} optimization to avoid constructing intermediate representations along the way to computing the result. -The forms in this module extend the syntax of the @seclink["The_Qi_Core_Language"]{core Qi language}. This extended syntax is given below: +The forms in this module extend the syntax of the +@seclink["The_Qi_Core_Language"]{core Qi language}. This extended +syntax is given below: @racketgrammar*[ [floe (map floe) @@ -22,6 +24,8 @@ The forms in this module extend the syntax of the @seclink["The_Qi_Core_Language (filter-map floe) (foldl floe expr) (foldr floe expr) + (range expr) + (range expr expr) (range expr expr expr) (take expr) car From efe32683f7a8cd4ca30ba74b46ca8fd96c2abbb0 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Sat, 28 Dec 2024 02:49:31 -0700 Subject: [PATCH 096/108] change deforestable "spec" syntax Just `f` and `e` seem to make it hard to know which is the actual binding position in, e.g., `[f f] [e e]`, so that we might be tempted to write something like `[my-func f]`. Using the nonterminal names `floe` and `expr` seem more explicit in indicating what kind of syntax is expected while avoiding potential confusion with the binding position. --- qi-lib/flow/core/compiler/1000-qi0.rkt | 4 ++-- qi-lib/flow/core/compiler/deforest/syntax.rkt | 20 +++++++++---------- qi-lib/flow/extended/expander.rkt | 4 ++-- qi-lib/list.rkt | 16 +++++++-------- qi-lib/macro.rkt | 2 +- qi-test/tests/expander.rkt | 6 +++--- 6 files changed, 26 insertions(+), 26 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 12ca24065..16e9985ec 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -394,8 +394,8 @@ the DSL. (define (deforestable-clause-parser c) (syntax-parse c - [((~datum f) e) #'(qi0->racket e)] - [((~datum e) e) #'e])) + [((~datum floe) e) #'(qi0->racket e)] + [((~datum expr) e) #'e])) (define (deforestable-parser e) (syntax-parse e diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt index a3fe6d845..f13a0fee6 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -50,7 +50,7 @@ #:attributes (blanket? fine? arg pre-arg post-arg) #:literal-sets (fs-literals) #:datum-literals (range) - (pattern (#%deforestable range _info ((~datum e) the-arg) ...) + (pattern (#%deforestable range _info ((~datum expr) the-arg) ...) #:attr arg #'(the-arg ...) #:attr pre-arg #f #:attr post-arg #f @@ -79,28 +79,28 @@ #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter) - (pattern (#%deforestable filter _info ((~datum f) f-uncompiled)) + (pattern (#%deforestable filter _info ((~datum floe) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-map #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (map) - (pattern (#%deforestable map _info ((~datum f) f-uncompiled)) + (pattern (#%deforestable map _info ((~datum floe) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-filter-map #:attributes (f) #:literal-sets (fs-literals) #:datum-literals (filter-map) - (pattern (#%deforestable filter-map _info ((~datum f) f-uncompiled)) + (pattern (#%deforestable filter-map _info ((~datum floe) f-uncompiled)) #:attr f (run-passes #'f-uncompiled))) (define-syntax-class fst-take #:attributes (n) #:literal-sets (fs-literals) #:datum-literals (take) - (pattern (#%deforestable take _info ((~datum e) n)))) + (pattern (#%deforestable take _info ((~datum expr) n)))) (define-syntax-class fst-syntax0 (pattern (~or _:fst-filter @@ -127,8 +127,8 @@ (pattern (#%deforestable foldr _info - ((~datum f) op-uncompiled) - ((~datum e) init)) + ((~datum floe) op-uncompiled) + ((~datum expr) init)) #:attr op (run-passes #'op-uncompiled))) (define-syntax-class fsc-foldl @@ -138,8 +138,8 @@ (pattern (#%deforestable foldl _info - ((~datum f) op-uncompiled) - ((~datum e) init)) + ((~datum floe) op-uncompiled) + ((~datum expr) init)) #:attr op (run-passes #'op-uncompiled))) (define-syntax-class cad*r-datum @@ -155,7 +155,7 @@ #:literal-sets (fs-literals) #:datum-literals (list-ref) ;; TODO: need #%host-expression wrapping idx? - (pattern (#%deforestable list-ref _info ((~datum e) idx)) + (pattern (#%deforestable list-ref _info ((~datum expr) idx)) #:attr pos #'idx #:attr name #'list-ref) ;; TODO: bring wrapping #%deforestable out here? diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index 7206ade51..580275097 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -245,8 +245,8 @@ core language's use of #%app, etc.). #'(esc spaced-f))) (nonterminal deforestable-clause - ((~datum f) e:closed-floe) - ((~datum e) g:racket-expr)) + ((~datum floe) e:closed-floe) + ((~datum expr) g:racket-expr)) (nonterminal arg-stx (~datum _) diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt index dd0c57fd4..29905ef35 100644 --- a/qi-lib/list.rkt +++ b/qi-lib/list.rkt @@ -16,27 +16,27 @@ (prefix-in r: racket/base) (prefix-in r: racket/list)) -(define-deforestable (map [f f]) +(define-deforestable (map [floe f]) #'(lambda (vs) ; single list arg (r:map f vs))) -(define-deforestable (filter [f f]) +(define-deforestable (filter [floe f]) #'(λ (vs) (r:filter f vs))) -(define-deforestable (filter-map [f f]) +(define-deforestable (filter-map [floe f]) #'(λ (vs) (r:filter-map f vs))) -(define-deforestable (foldl [f f] [e init]) +(define-deforestable (foldl [floe f] [expr init]) #'(λ (vs) (r:foldl f init vs))) -(define-deforestable (foldr [f f] [e init]) +(define-deforestable (foldr [floe f] [expr init]) #'(λ (vs) (r:foldr f init vs))) -(define-deforestable (range [e low] [e high] [e step]) +(define-deforestable (range [expr low] [expr high] [expr step]) #'(λ () (r:range low high step))) @@ -58,7 +58,7 @@ "(range arg ...)" "range expects at least one argument")]) -(define-deforestable (take [e n]) +(define-deforestable (take [expr n]) #'(λ (vs) (r:take vs n))) @@ -74,7 +74,7 @@ (define-deforestable cadddr #'r:cadddr) -(define-deforestable (list-ref [e n]) +(define-deforestable (list-ref [expr n]) #'(λ (vs) (r:list-ref vs n))) diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index e9601cb93..9bceb86ea 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -141,7 +141,7 @@ (define-syntax define-deforestable (syntax-parser [(_ (name spec ...+) codegen) - #:with ([typ arg] ...) #'(spec ...) + #:with ([_typ arg] ...) #'(spec ...) #:with codegen-f #'(lambda (arg ...) ;; var bindings vs pattern bindings ;; arg are syntax objects but we can't diff --git a/qi-test/tests/expander.rkt b/qi-test/tests/expander.rkt index baaf30ffa..a41b57a9f 100644 --- a/qi-test/tests/expander.rkt +++ b/qi-test/tests/expander.rkt @@ -105,11 +105,11 @@ (#%host-expression 1) __)))) (test-expand "#%deforestable" - #'(#%deforestable name info (f 0) (e 0)) + #'(#%deforestable name info (floe 0) (expr 0)) #'(#%deforestable name info - (f (gen (#%host-expression 0))) - (e (#%host-expression 0))))) + (floe (gen (#%host-expression 0))) + (expr (#%host-expression 0))))) (test-suite "utils" ;; this is just temporary until we properly track source expressions through From db48273264c3af9d8c61e117368bdbca833eea23 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 13 Dec 2024 19:05:40 -0700 Subject: [PATCH 097/108] Add Makefile target to use the "preview" profile in `vlibench` This runs in under a minute so it's useful for local testing, but not as reliable as the longer-running jobs run on CI using the "github" profile (which can also be run locally but would take a long time). --- Makefile | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 3658b7c1d..668b2c549 100644 --- a/Makefile +++ b/Makefile @@ -217,6 +217,17 @@ new-benchmarks: --dest-name index.html \ report.scrbl +new-benchmarks-preview: + cd qi-sdk/benchmarks/competitive && \ + scribble \ + ++convert svg \ + ++arg -p \ + ++arg preview \ + --html \ + --dest results \ + --dest-name index.html \ + report.scrbl + benchmark-local: racket $(PACKAGE-NAME)-sdk/benchmarks/local/report.rkt @@ -240,4 +251,4 @@ performance-report: performance-regression-report: @racket $(PACKAGE-NAME)-sdk/benchmarks/report.rkt -r $(REF) -.PHONY: help install remove build build-docs build-all clean check-deps test test-flow test-on test-threading test-switch test-definitions test-macro test-util test-expander test-compiler test-probe test-with-errortrace errortrace errortrace-flow errortrace-on errortrace-threading errortrace-switch errortrace-definitions errortrace-macro errortrace-util errortrace-probe docs cover coverage-check coverage-report cover-coveralls profile new-benchmarks benchmark-local benchmark-loading benchmark-selected-forms benchmark-competitive benchmark-nonlocal benchmark performance-report performance-regression-report +.PHONY: help install remove build build-docs build-all clean check-deps test test-flow test-on test-threading test-switch test-definitions test-macro test-util test-expander test-compiler test-probe test-with-errortrace errortrace errortrace-flow errortrace-on errortrace-threading errortrace-switch errortrace-definitions errortrace-macro errortrace-util errortrace-probe docs cover coverage-check coverage-report cover-coveralls profile new-benchmarks new-benchmarks-preview benchmark-local benchmark-loading benchmark-selected-forms benchmark-competitive benchmark-nonlocal benchmark performance-report performance-regression-report From db7fe61e3d1758ef22094458efe7224230583799 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 13 Dec 2024 19:32:18 -0700 Subject: [PATCH 098/108] Improve Makefile targets for testing Since `make build` no longer compiles `qi-test`, this compiles the necessary test modules before running tests. It also separates out the `qi-probe` tests, and ensures that we run the full suite of tests in CI. --- .github/workflows/test.yml | 2 +- Makefile | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index d844ca173..08f0a3a42 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -36,7 +36,7 @@ jobs: - name: Check Dependencies run: make check-deps - name: Run Tests - run: make test + run: make test-all coverage: needs: test runs-on: ubuntu-latest diff --git a/Makefile b/Makefile index 668b2c549..581c01a21 100644 --- a/Makefile +++ b/Makefile @@ -116,11 +116,14 @@ clean-sdk: check-deps: raco setup --no-docs $(DEPS-FLAGS) $(PACKAGE-NAME) +test-all: test test-probe + # Suitable for both day-to-day dev and CI # Note: we don't test qi-doc since there aren't any tests there atm # and it also seems to make things extremely slow to include it. -test: - raco test -exp $(PACKAGE-NAME)-{lib,test,probe} +test: build + raco make -l qi/tests/qi -v + raco test -exp $(PACKAGE-NAME)-{lib,test} test-flow: racket -y $(PACKAGE-NAME)-test/tests/flow.rkt @@ -251,4 +254,4 @@ performance-report: performance-regression-report: @racket $(PACKAGE-NAME)-sdk/benchmarks/report.rkt -r $(REF) -.PHONY: help install remove build build-docs build-all clean check-deps test test-flow test-on test-threading test-switch test-definitions test-macro test-util test-expander test-compiler test-probe test-with-errortrace errortrace errortrace-flow errortrace-on errortrace-threading errortrace-switch errortrace-definitions errortrace-macro errortrace-util errortrace-probe docs cover coverage-check coverage-report cover-coveralls profile new-benchmarks new-benchmarks-preview benchmark-local benchmark-loading benchmark-selected-forms benchmark-competitive benchmark-nonlocal benchmark performance-report performance-regression-report +.PHONY: help install remove build build-docs build-all clean check-deps test-all test test-flow test-on test-threading test-switch test-definitions test-macro test-util test-expander test-compiler test-probe test-with-errortrace errortrace errortrace-flow errortrace-on errortrace-threading errortrace-switch errortrace-definitions errortrace-macro errortrace-util errortrace-probe docs cover coverage-check coverage-report cover-coveralls profile new-benchmarks new-benchmarks-preview benchmark-local benchmark-loading benchmark-selected-forms benchmark-competitive benchmark-nonlocal benchmark performance-report performance-regression-report From 6797eb3d00c5cb741a54b35b41828c52a81427d4 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Tue, 31 Dec 2024 20:00:23 -0700 Subject: [PATCH 099/108] test a few cases that weren't covered --- qi-test/tests/list.rkt | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/qi-test/tests/list.rkt b/qi-test/tests/list.rkt index 416df6b0f..eb81085e7 100644 --- a/qi-test/tests/list.rkt +++ b/qi-test/tests/list.rkt @@ -15,6 +15,17 @@ (test-suite "qi/list tests" + (test-suite + "syntax" + (check-exn exn:fail? + (thunk (convert-compile-time-error + (☯ (filter odd? (list 1 2 3))))) + "more arguments are provided than indicated in the spec") + (check-exn exn:fail? + (thunk (convert-compile-time-error + (☯ filter))) + "form is used as an identifier but the spec indicates expected arguments")) + (test-suite "basic" @@ -272,6 +283,18 @@ ((☯ (~> (range 10) car))) 0) + (test-equal? "range..cadr" + ((☯ (~> (range 10) + cadr))) + 1) + (test-equal? "range..caddr" + ((☯ (~> (range 10) + caddr))) + 2) + (test-equal? "range..cadddr" + ((☯ (~> (range 10) + cadddr))) + 3) (test-equal? "range..map" ((☯ (~> (range 3) (map sqr)))) From 04589f20ee97579fd89f1c96df378f8ac023ba33 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 1 Jan 2025 13:08:40 -0700 Subject: [PATCH 100/108] Add `#%deforestable` to the de-expander A couple of things to note: 1. This de-expansion relies on the presence of the _name_ of the original form in the syntax of `#%deforestable`. But we have already discussed (meeting notes: "Playing Like a Grandmaster") that this is only a temporary feature of its syntax and we would like to remove it, as the compile-time metadata carried by the syntax (i.e., `info`) should contain all relevant semantics. In particular, the deforestation pass is intended to only operate in terms of stream primitives such as "transformers" and "consumers" to which all surface deforestable operations (such as `map` and `filter`) would translate. And if the form is undeforested, code generation at the last stage of compilation will use whatever implementation was provided by the user. In either case, a literal name is not needed. But if we remove it, how will we continue to "de-expand" this to provide a good error message? 2. The grammar of `#%deforestable` is slightly nontrivial and is another reminder that we are in actuality encoding a duplicate grammar here separately from the one already notated in Syntax Spec, and this could be prone to bugs. --- qi-lib/flow/extended/util.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/qi-lib/flow/extended/util.rkt b/qi-lib/flow/extended/util.rkt index 4a467f205..0b33bf3e3 100644 --- a/qi-lib/flow/extended/util.rkt +++ b/qi-lib/flow/extended/util.rkt @@ -35,7 +35,8 @@ feedback loop loop2 - clos) + clos + #%deforestable) [(thread expr ...) #`(~> #,@(map prettify-flow-syntax (syntax->list #'(expr ...))))] @@ -118,4 +119,5 @@ expr ...) #`(clos #,@(map prettify-flow-syntax (syntax->list #'(expr ...))))] [(esc expr) (prettify-flow-syntax #'expr)] + [(#%deforestable name _info ((~or* (~datum floe) (~datum expr)) expr) ...) #`(name #,@(map prettify-flow-syntax (syntax->list #'(expr ...))))] [expr #'expr])) From 17fafe782b2e54f201af3f6e0f3f427f482694b9 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 2 Jan 2025 00:16:42 -0700 Subject: [PATCH 101/108] test for de-expanding `#%deforestable` --- qi-lib/flow/extended/util.rkt | 3 ++- qi-test/tests/expander.rkt | 6 ++++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/qi-lib/flow/extended/util.rkt b/qi-lib/flow/extended/util.rkt index 0b33bf3e3..cab43f4ce 100644 --- a/qi-lib/flow/extended/util.rkt +++ b/qi-lib/flow/extended/util.rkt @@ -119,5 +119,6 @@ expr ...) #`(clos #,@(map prettify-flow-syntax (syntax->list #'(expr ...))))] [(esc expr) (prettify-flow-syntax #'expr)] - [(#%deforestable name _info ((~or* (~datum floe) (~datum expr)) expr) ...) #`(name #,@(map prettify-flow-syntax (syntax->list #'(expr ...))))] + [(#%deforestable name _info ((~or* (~datum floe) (~datum expr)) expr) ...) + #`(name #,@(map prettify-flow-syntax (syntax->list #'(expr ...))))] [expr #'expr])) diff --git a/qi-test/tests/expander.rkt b/qi-test/tests/expander.rkt index a41b57a9f..94c587b8b 100644 --- a/qi-test/tests/expander.rkt +++ b/qi-test/tests/expander.rkt @@ -149,7 +149,8 @@ (esc (#%host-expression f)) (#%blanket-template ((#%host-expression 1) __ (#%host-expression 4))) (#%blanket-template ((#%host-expression 4) __)) - (#%fine-template ((#%host-expression 4) _)))))) + (#%fine-template ((#%host-expression 4) _)) + (#%deforestable map info (floe (amp (esc (#%host-expression f)))) (expr 3)))))) '(flow (gen f) ground (select 1 2) @@ -180,7 +181,8 @@ f (1 __ 4) (4 __) - (4 _)))))) + (4 _) + (map (>< f) 3)))))) (module+ main (void From 6bf3e07cf1724eaa52b9aa82b18e7ae1605b6cd0 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 3 Jan 2025 13:40:12 -0700 Subject: [PATCH 102/108] wrap benchmarks with lambda to accommodate new `range` --- qi-sdk/benchmarks/competitive/report.scrbl | 40 +++++++++++++--------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/qi-sdk/benchmarks/competitive/report.scrbl b/qi-sdk/benchmarks/competitive/report.scrbl index 8e8f19b91..660b92a1d 100644 --- a/qi-sdk/benchmarks/competitive/report.scrbl +++ b/qi-sdk/benchmarks/competitive/report.scrbl @@ -64,17 +64,20 @@ (define qi-long-pipeline-prog (make-vlib/prog impl-label - (flow (~>> range - (filter odd?) - (map sqr) - values - (filter (lambda (v) (< (remainder v 10) 5))) - (map (lambda (v) (* v 2))) - (foldl + 0))))) + (λ (high) + (~>> () + (range high) + (filter odd?) + (map sqr) + values + (filter (lambda (v) (< (remainder v 10) 5))) + (map (lambda (v) (* v 2))) + (foldl + 0))))) (define qi-range-map-car-prog (make-vlib/prog impl-label - (flow (~>> range (map sqr) car)))) + (λ (high) + (~>> () (range high) (map sqr) car)))) ) @(module qi-deforested racket/base @@ -100,21 +103,24 @@ (define qi/d-long-pipeline-prog (make-vlib/prog impl-label - (flow (~>> range - (filter odd?) - (map sqr) - values - (filter (lambda (v) (< (remainder v 10) 5))) - (map (lambda (v) (* v 2))) - (foldl + 0))))) + (λ (high) + (~>> () + (range high) + (filter odd?) + (map sqr) + values + (filter (lambda (v) (< (remainder v 10) 5))) + (map (lambda (v) (* v 2))) + (foldl + 0))))) (define qi/d-range-map-car-prog (make-vlib/prog impl-label - (flow (~>> range (map sqr) car)))) + (λ (high) + (~>> () (range high) (map sqr) car)))) ) @(require 'qi-default - 'qi-deforested) + 'qi-deforested) @(define benchmarks-specs (list From ffc767ebd18c0076711d2c23cd510476941e8e4e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 3 Jan 2025 13:47:27 -0700 Subject: [PATCH 103/108] Address "unused dependencies" warnings (fix #174) It still shows `macro-debugger`, `cover` and `cover-coveralls` as unused. There doesn't seem to be a good way around this for the moment. (done in today's meeting) --- qi-doc/scribblings/forms.scrbl | 1 + qi-lib/info.rkt | 3 +++ qi-sdk/info.rkt | 11 ++++++++--- 3 files changed, 12 insertions(+), 3 deletions(-) diff --git a/qi-doc/scribblings/forms.scrbl b/qi-doc/scribblings/forms.scrbl index e22e864b6..38bf91ba0 100644 --- a/qi-doc/scribblings/forms.scrbl +++ b/qi-doc/scribblings/forms.scrbl @@ -2,6 +2,7 @@ @require[scribble/manual scribble-abbrevs/manual scribble/example + metapict ; technically only used dynamically, but adding here for info deps "eval.rkt" @for-label[(only-space-in qi qi) racket]] diff --git a/qi-lib/info.rkt b/qi-lib/info.rkt index 4289047b2..80326936d 100644 --- a/qi-lib/info.rkt +++ b/qi-lib/info.rkt @@ -5,6 +5,9 @@ (define deps '("base" ("fancy-app" #:version "1.1") "syntax-spec-v2" + ;; we do need this, but it does need to be + ;; dynamic-require'd, so raco doesn't see + ;; it as a compile-time dependency "macro-debugger")) (define build-deps '()) (define clean '("compiled" "private/compiled")) diff --git a/qi-sdk/info.rkt b/qi-sdk/info.rkt index 538de19c4..3ca6a2cca 100644 --- a/qi-sdk/info.rkt +++ b/qi-sdk/info.rkt @@ -7,13 +7,18 @@ "adjutor" "cli" "math-lib" - "collections-lib" "relation-lib" "csv-writing" "require-latency" - "vlibench" + ;; these are only used via `raco` in the Makefile, + ;; and so they don't appear as dependencies of the + ;; modules in this package but they are still needed "cover" "cover-coveralls")) -(define build-deps '()) +(define build-deps '("vlibench" + "scribble-lib" + "scribble-math" + "srfi-lite-lib")) +(define module-suffixes '(#"scrbl")) (define clean '("compiled" "private/compiled")) (define pkg-authors '(countvajhula)) From 4b1ba3f29b28ef83889c427d383bc0da5d67b649 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 6 Jan 2025 01:31:26 -0700 Subject: [PATCH 104/108] Use of left-threading for list operations in docs Favor left threading, and note a commonly-encountered error in this connection. --- qi-doc/scribblings/field-guide.scrbl | 4 +++- qi-doc/scribblings/qi.scrbl | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/qi-doc/scribblings/field-guide.scrbl b/qi-doc/scribblings/field-guide.scrbl index c1c8e63fe..8c98741c4 100644 --- a/qi-doc/scribblings/field-guide.scrbl +++ b/qi-doc/scribblings/field-guide.scrbl @@ -298,7 +298,7 @@ Qi aims to produce good error messages that convey what the problem is and clear @bold{Common example}: Attempting to use a Qi macro in one module without @racketlink[provide]{providing} it from the module where it is defined -- note that Qi macros must be provided as @racket[(provide (for-space qi mac))]. See @secref["Using_Macros" #:doc '(lib "qi/scribblings/qi.scrbl")] for more on this. -@subsubsection{Contract Violation} +@subsubsection{@racket[map]/@racket[filter] Contract Violation} @codeblock{ ; map: contract violation @@ -308,6 +308,8 @@ Qi aims to produce good error messages that convey what the problem is and clear @bold{Meaning}: The interpreter attempted to apply a function to arguments but found that an argument was not of the expected type. +@bold{Common example}: Using @racket[map] or @racket[filter] without first @racket[(require qi/list)]. The built-in Racket versions are @emph{functions} that expect the input list argument at a specific position (i.e., on the right), whereas the Qi versions are @emph{macros} that are invariant to threading direction and expect precisely one input -- the list itself. + @bold{Common example}: Using a nested flow (such as a @racket[tee] junction or an @racket[effect]) within a right-threading flow and assuming that the input arguments would be passed on the right. At the moment, Qi does not propagate the threading direction to nested clauses. You could either use a fresh right threading form or indicate the argument positions explicitly in the nested flow using an @seclink["Templates_and_Partial_Application"]{argument template}. @subsubsection{Compose: Contract Violation} diff --git a/qi-doc/scribblings/qi.scrbl b/qi-doc/scribblings/qi.scrbl index c76c7f85c..b59dd4608 100644 --- a/qi-doc/scribblings/qi.scrbl +++ b/qi-doc/scribblings/qi.scrbl @@ -19,7 +19,7 @@ An embeddable, general-purpose language to allow convenient framing of programmi Tired of writing long functional pipelines with nested syntax like this? @racketblock[(map _f (filter _g (vector->list _my-awesome-data)))] Then Qi is for you! -@racketblock[(~>> (_my-awesome-data) vector->list (filter _g) (map _f))] +@racketblock[(~> (_my-awesome-data) vector->list (filter _g) (map _f))] But wait, there's more: Qi isn't just a turbo-charged threading language. It supports multiple values and a suite of other operators for describing computations: From 07ecec5a1512575eec39ae815529f5997031fb22 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 11 Jan 2025 17:20:57 +0100 Subject: [PATCH 105/108] Add competitive benchmark for take of 1/3 the input size. --- qi-sdk/benchmarks/competitive/report.scrbl | 25 +++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/qi-sdk/benchmarks/competitive/report.scrbl b/qi-sdk/benchmarks/competitive/report.scrbl index 660b92a1d..ad06f6691 100644 --- a/qi-sdk/benchmarks/competitive/report.scrbl +++ b/qi-sdk/benchmarks/competitive/report.scrbl @@ -50,7 +50,8 @@ (provide qi-filter-map-prog qi-filter-map-foldl-prog qi-long-pipeline-prog - qi-range-map-car-prog) + qi-range-map-car-prog + qi-range-map-take-prog) (define impl-label "Qi") @@ -78,6 +79,12 @@ (make-vlib/prog impl-label (λ (high) (~>> () (range high) (map sqr) car)))) + + (define qi-range-map-take-prog + (make-vlib/prog impl-label + (lambda (high) + (define n (add1 (quotient high 3))) + (~>> () (range high) (map sqr) (take _ n))))) ) @(module qi-deforested racket/base @@ -89,7 +96,8 @@ (provide qi/d-filter-map-prog qi/d-filter-map-foldl-prog qi/d-long-pipeline-prog - qi/d-range-map-car-prog) + qi/d-range-map-car-prog + qi/d-range-map-take-prog) (define impl-label "Qi deforested") @@ -117,6 +125,13 @@ (make-vlib/prog impl-label (λ (high) (~>> () (range high) (map sqr) car)))) + + (define qi/d-range-map-take-prog + (make-vlib/prog impl-label + (lambda (high) + (define n (add1 (quotient high 3))) + (~>> () (range high) (map sqr) (take n))))) + ) @(require 'qi-default @@ -139,7 +154,11 @@ (vlib/spec 'range-map-car identity (list qi/d-range-map-car-prog - qi-range-map-car-prog)))) + qi-range-map-car-prog)) + (vlib/spec 'range-map-take + identity + (list qi/d-range-map-take-prog + qi-range-map-take-prog)))) @; Processing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @define[profile (hash-ref vlib/profiles config-profile)] From 175327737257398843c964d48a2e10cf281c6f60 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Tue, 14 Jan 2025 11:12:51 -0700 Subject: [PATCH 106/108] rename "impl" modules to "runtime", as discussed some time ago --- qi-lib/flow/core/compiler/1000-qi0.rkt | 2 +- qi-lib/flow/core/{impl.rkt => runtime.rkt} | 0 qi-lib/flow/extended/forms.rkt | 2 +- qi-lib/flow/extended/{impl.rkt => runtime.rkt} | 0 qi-lib/flow/extended/syntax.rkt | 2 +- qi-test/tests/compiler.rkt | 4 ++-- qi-test/tests/compiler/{impl.rkt => runtime.rkt} | 2 +- 7 files changed, 6 insertions(+), 6 deletions(-) rename qi-lib/flow/core/{impl.rkt => runtime.rkt} (100%) rename qi-lib/flow/extended/{impl.rkt => runtime.rkt} (100%) rename qi-test/tests/compiler/{impl.rkt => runtime.rkt} (97%) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 16e9985ec..3e25295c8 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -2,7 +2,7 @@ (require "../passes.rkt" (prefix-in fancy: fancy-app) - "../impl.rkt" + "../runtime.rkt" racket/function racket/list (for-syntax racket/base diff --git a/qi-lib/flow/core/impl.rkt b/qi-lib/flow/core/runtime.rkt similarity index 100% rename from qi-lib/flow/core/impl.rkt rename to qi-lib/flow/core/runtime.rkt diff --git a/qi-lib/flow/extended/forms.rkt b/qi-lib/flow/extended/forms.rkt index 5f921b26c..a71525758 100644 --- a/qi-lib/flow/extended/forms.rkt +++ b/qi-lib/flow/extended/forms.rkt @@ -17,7 +17,7 @@ "../../macro.rkt" (only-in "../space.rkt" define-for-qi) - "impl.rkt") + "runtime.rkt") ;;; Predicates diff --git a/qi-lib/flow/extended/impl.rkt b/qi-lib/flow/extended/runtime.rkt similarity index 100% rename from qi-lib/flow/extended/impl.rkt rename to qi-lib/flow/extended/runtime.rkt diff --git a/qi-lib/flow/extended/syntax.rkt b/qi-lib/flow/extended/syntax.rkt index 1691380e9..3408794fa 100644 --- a/qi-lib/flow/extended/syntax.rkt +++ b/qi-lib/flow/extended/syntax.rkt @@ -12,7 +12,7 @@ (require syntax/parse "../aux-syntax.rkt" - (for-template "impl.rkt")) + (for-template "runtime.rkt")) (define-syntax-class conjux-clause ; "juxtaposed" conjoin #:attributes (parsed) diff --git a/qi-test/tests/compiler.rkt b/qi-test/tests/compiler.rkt index 0c2e7f8de..35e37dcf3 100644 --- a/qi-test/tests/compiler.rkt +++ b/qi-test/tests/compiler.rkt @@ -6,7 +6,7 @@ rackunit/text-ui (prefix-in rules: "compiler/rules.rkt") (prefix-in strategy: "compiler/strategy.rkt") - (prefix-in impl: "compiler/impl.rkt")) + (prefix-in runtime: "compiler/runtime.rkt")) (define tests (test-suite @@ -14,7 +14,7 @@ rules:tests strategy:tests - impl:tests)) + runtime:tests)) (module+ main (void diff --git a/qi-test/tests/compiler/impl.rkt b/qi-test/tests/compiler/runtime.rkt similarity index 97% rename from qi-test/tests/compiler/impl.rkt rename to qi-test/tests/compiler/runtime.rkt index 052f6c0e9..e50d3ddc6 100644 --- a/qi-test/tests/compiler/impl.rkt +++ b/qi-test/tests/compiler/runtime.rkt @@ -2,7 +2,7 @@ (provide tests) -(require qi/flow/core/impl +(require qi/flow/core/runtime rackunit rackunit/text-ui (only-in racket/function thunk)) From 3d661fb6cf1f7dd3e60af0fb7e6cf3ff85198cb7 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 15 Jan 2025 19:12:29 -0700 Subject: [PATCH 107/108] add back symbolic aliases that got dropped at some point --- qi-lib/flow/core/compiler/1000-qi0.rkt | 15 +++++++++++++++ qi-lib/flow/extended/expander.rkt | 3 ++- qi-lib/flow/extended/forms.rkt | 4 +++- qi-test/tests/flow.rkt | 3 +++ 4 files changed, 23 insertions(+), 2 deletions(-) diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt index 3e25295c8..05f746480 100644 --- a/qi-lib/flow/core/compiler/1000-qi0.rkt +++ b/qi-lib/flow/core/compiler/1000-qi0.rkt @@ -28,6 +28,21 @@ ;;;; Core language forms ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; A note regarding symbolic aliases like ~>, ⏚ and △: + ;; + ;; These aren't technically part of the core language + ;; as they aren't directly part of the syntax + ;; spec in the expander (which includes only, e.g., + ;; thread and tee and so on). Instead, they are simply + ;; aliased at the module level there when provided. + ;; Yet, during code generation in the present module, + ;; it's more convenient to express expansions + ;; using these symbolic aliases, and that's the + ;; reason we retain these in the patterns below. As + ;; these patterns are matched as _datum literals_, + ;; it doesn't matter that they aren't actually the + ;; literal core forms declared in the expander. + [((~datum gen) ex:expr ...) #'(λ _ (values ex ...))] ;; pass-through (identity flow) diff --git a/qi-lib/flow/extended/expander.rkt b/qi-lib/flow/extended/expander.rkt index 580275097..d0dbfe95b 100644 --- a/qi-lib/flow/extended/expander.rkt +++ b/qi-lib/flow/extended/expander.rkt @@ -10,7 +10,8 @@ [tee -<] [amp ><] [sep △] - [collect ▽]))) + [collect ▽] + [NOT !]))) (require syntax-spec-v2 "../space.rkt" diff --git a/qi-lib/flow/extended/forms.rkt b/qi-lib/flow/extended/forms.rkt index a71525758..f9b9ecf35 100644 --- a/qi-lib/flow/extended/forms.rkt +++ b/qi-lib/flow/extended/forms.rkt @@ -7,7 +7,9 @@ (rename-out [thread-right ~>>] [crossover X] [relay* ==*] - [effect ε]))) + [effect ε] + [AND &] + [OR ∥]))) (require (for-syntax racket/base "syntax.rkt" diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index 46ed1e410..382bccf7f 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -294,6 +294,7 @@ "elementary boolean gates" (test-suite "AND" + (check-equal? ((☯ &) 3 5 7) 7) (check-equal? ((☯ AND) #f) #f) (check-equal? ((☯ AND) 3) 3) (check-equal? ((☯ AND) 3 5 7) 7) @@ -302,6 +303,7 @@ (check-equal? ((☯ AND) #f #f #f) #f)) (test-suite "OR" + (check-equal? ((☯ ∥) 3 5 7) 3) (check-equal? ((☯ OR) #f) #f) (check-equal? ((☯ OR) 3) 3) (check-equal? ((☯ OR) 3 5 7) 3) @@ -310,6 +312,7 @@ (check-equal? ((☯ OR) #f #f #f) #f)) (test-suite "NOT" + (check-false ((☯ !) 3)) (check-false ((☯ NOT) 3)) (check-true ((☯ NOT) #f))) (test-suite From f84dc92db7468c9c0c08d13814e33e443f11a86e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Wed, 15 Jan 2025 19:14:52 -0700 Subject: [PATCH 108/108] Add COPYING file containing public domain dedication This satisfies the basic requirements for a public domain dedication as discussed in, e.g., https://cr.yp.to/publicdomain.html. Use of a COPYING file is a convention advocated by GNU and the FSF, and is recognized by most tools. Closes #8 --- COPYING | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 COPYING diff --git a/COPYING b/COPYING new file mode 100644 index 000000000..491d5ce70 --- /dev/null +++ b/COPYING @@ -0,0 +1,2 @@ +This is free and unencumbered software released into the public domain. +The authors relinquish any copyright claims on this work.