From 3378f0e5bdd0dd57af4999f82484bf9b3d345c09 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 00:08:57 -0800 Subject: [PATCH 01/16] add `range-map` benchmark --- qi-sdk/profile/nonlocal/qi/main.rkt | 5 +++++ qi-sdk/profile/nonlocal/racket/main.rkt | 4 ++++ qi-sdk/profile/nonlocal/spec.rkt | 3 +++ 3 files changed, 12 insertions(+) diff --git a/qi-sdk/profile/nonlocal/qi/main.rkt b/qi-sdk/profile/nonlocal/qi/main.rkt index 6636aa7c..5f2288f4 100644 --- a/qi-sdk/profile/nonlocal/qi/main.rkt +++ b/qi-sdk/profile/nonlocal/qi/main.rkt @@ -12,6 +12,7 @@ pingala eratosthenes collatz + range-map filter-map filter-map-foldr filter-map-foldl @@ -83,6 +84,10 @@ (map sqr) (foldl + 0))) +(define-flow range-map + (~>> (range 0) + (map sqr))) + ;; (define-flow filter-map ;; (~>> (filter odd?) ;; (map sqr) diff --git a/qi-sdk/profile/nonlocal/racket/main.rkt b/qi-sdk/profile/nonlocal/racket/main.rkt index e40670fb..52546204 100644 --- a/qi-sdk/profile/nonlocal/racket/main.rkt +++ b/qi-sdk/profile/nonlocal/racket/main.rkt @@ -7,6 +7,7 @@ pingala eratosthenes collatz + range-map filter-map filter-map-foldr filter-map-foldl @@ -58,6 +59,9 @@ [(odd? n) (cons n (collatz (+ (* 3 n) 1)))] [(even? n) (cons n (collatz (quotient n 2)))])) +(define (range-map v) + (map sqr (range 0 v))) + (define (filter-map lst) (map sqr (filter odd? lst))) diff --git a/qi-sdk/profile/nonlocal/spec.rkt b/qi-sdk/profile/nonlocal/spec.rkt index b6e640f6..6f9e4695 100644 --- a/qi-sdk/profile/nonlocal/spec.rkt +++ b/qi-sdk/profile/nonlocal/spec.rkt @@ -20,6 +20,9 @@ (bm "root-mean-square" check-list 500000) + (bm "range-map" + check-value + 500000) (bm "filter-map" check-list 500000) From 25ef1953b21b668350df0bc70814c5ee435f8bb8 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 12:04:00 -0800 Subject: [PATCH 02/16] fix compiler tests --- qi-test/tests/compiler.rkt | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/qi-test/tests/compiler.rkt b/qi-test/tests/compiler.rkt index 07ceb8ae..8155dadd 100644 --- a/qi-test/tests/compiler.rkt +++ b/qi-test/tests/compiler.rkt @@ -20,6 +20,7 @@ #'(#%partial-application ((#%host-expression filter) (#%host-expression odd?))))]) + ;; note this tests the rule in isolation; with normalization this would never be necessary (check-equal? (syntax->datum (deforest-rewrite #`(thread #,stx))) @@ -27,19 +28,17 @@ (esc (λ (lst) ((cstream->list (inline-compose1 (filter-cstream-next odd?) list->cstream-next)) lst)))) - "deforestation of map -- note this tests the rule in isolation; with normalization this would never be necessary")) + "deforest filter")) (let ([stx (make-right-chiral #'(#%partial-application ((#%host-expression map) (#%host-expression sqr))))]) + ;; note this tests the rule in isolation; with normalization this would never be necessary (check-equal? (syntax->datum (deforest-rewrite #`(thread #,stx))) - '(thread - (esc - (λ (lst) - ((cstream->list (inline-compose1 (map-cstream-next sqr) list->cstream-next)) lst)))) - "deforestation of filter -- note this tests the rule in isolation; with normalization this would never be necessary")) + '(thread (#%partial-application ((#%host-expression map) (#%host-expression sqr)))) + "does not deforest map in the head position")) (let ([stx (map make-right-chiral (syntax->list #'(values @@ -70,7 +69,7 @@ (let ([stx (map make-right-chiral (syntax->list #'((#%partial-application - ((#%host-expression map) + ((#%host-expression filter) (#%host-expression string-upcase))) (#%partial-application ((#%host-expression foldl) @@ -86,7 +85,7 @@ string-append "I" (inline-compose1 - (map-cstream-next + (filter-cstream-next string-upcase) list->cstream-next)) lst)))) From fc674ec2b7311840bbc54920921deef99e4aa0c5 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 09:05:01 -0800 Subject: [PATCH 03/16] add a (failing) test for deforestation in nested positions --- qi-test/tests/compiler.rkt | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/qi-test/tests/compiler.rkt b/qi-test/tests/compiler.rkt index 8155dadd..05e40305 100644 --- a/qi-test/tests/compiler.rkt +++ b/qi-test/tests/compiler.rkt @@ -66,6 +66,34 @@ lst))) values) "deforestation in arbitrary positions")) + (let ([stx (map make-right-chiral + (syntax->list + #`(values + #,(cons 'thread (map make-right-chiral + (syntax->list + #'((#%partial-application + ((#%host-expression filter) + (#%host-expression odd?))) + (#%partial-application + ((#%host-expression map) + (#%host-expression sqr))))))))))]) + (check-equal? (syntax->datum + (deforest-rewrite + #`(thread #,@stx))) + '(thread + values + (esc + (λ (lst) + ((cstream->list + (inline-compose1 + (map-cstream-next + sqr) + (filter-cstream-next + odd?) + list->cstream-next)) + lst))) + values) + "deforestation in nested positions")) (let ([stx (map make-right-chiral (syntax->list #'((#%partial-application From e73be417f1001e83ef1495efacfa0b352b96e6f7 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 09:05:30 -0800 Subject: [PATCH 04/16] remove testing-related nesting in qi deforestation benchmark --- qi-sdk/profile/nonlocal/qi/main.rkt | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/qi-sdk/profile/nonlocal/qi/main.rkt b/qi-sdk/profile/nonlocal/qi/main.rkt index 5f2288f4..21c799bc 100644 --- a/qi-sdk/profile/nonlocal/qi/main.rkt +++ b/qi-sdk/profile/nonlocal/qi/main.rkt @@ -70,9 +70,8 @@ ;; (~>> (filter odd?) (map sqr))) (define-flow filter-map - (~>> values - (~>> (filter odd?) - (map sqr)))) + (~>> (filter odd?) + (map sqr))) (define-flow filter-map-foldr (~>> (filter odd?) From bb503def5e1f729feaacee6f6ee8995d60dbc806 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 12:07:40 -0800 Subject: [PATCH 05/16] validate that `range` deforestation doesn't harm performance --- qi-sdk/profile/nonlocal/spec.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qi-sdk/profile/nonlocal/spec.rkt b/qi-sdk/profile/nonlocal/spec.rkt index 6f9e4695..d1a76f5b 100644 --- a/qi-sdk/profile/nonlocal/spec.rkt +++ b/qi-sdk/profile/nonlocal/spec.rkt @@ -21,8 +21,8 @@ check-list 500000) (bm "range-map" - check-value - 500000) + check-value-large + 50000) (bm "filter-map" check-list 500000) From 4a7cd20ab3459357eb10f5726e4a9605582b16df Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 15:25:04 -0800 Subject: [PATCH 06/16] fix (most) compiler tests again --- qi-test/tests/compiler.rkt | 50 ++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 23 deletions(-) diff --git a/qi-test/tests/compiler.rkt b/qi-test/tests/compiler.rkt index 05e40305..261e7d3c 100644 --- a/qi-test/tests/compiler.rkt +++ b/qi-test/tests/compiler.rkt @@ -2,7 +2,7 @@ (provide tests) -(require (for-template qi/flow/core/compiler) +(require (for-template qi/flow/core/deforest) (only-in qi/flow/extended/syntax make-right-chiral) rackunit @@ -16,18 +16,21 @@ (test-suite "deforestation" ;; (~>> values (filter odd?) (map sqr) values) - (let ([stx (make-right-chiral - #'(#%partial-application - ((#%host-expression filter) - (#%host-expression odd?))))]) - ;; note this tests the rule in isolation; with normalization this would never be necessary + (let ([stx (map make-right-chiral + (syntax->list #'((#%partial-application + ((#%host-expression filter) + (#%host-expression odd?))) + (#%partial-application + ((#%host-expression map) + (#%host-expression sqr))))))]) (check-equal? (syntax->datum (deforest-rewrite - #`(thread #,stx))) + #`(thread #,@stx))) '(thread (esc - (λ (lst) - ((cstream->list (inline-compose1 (filter-cstream-next odd?) list->cstream-next)) lst)))) + (λ args + ((cstream-next->list (inline-compose1 (map-cstream-next sqr) (filter-cstream-next odd?) list->cstream-next)) + (apply identity args))))) "deforest filter")) (let ([stx (make-right-chiral #'(#%partial-application @@ -55,28 +58,29 @@ '(thread values (esc - (λ (lst) - ((cstream->list + (λ args + ((cstream-next->list (inline-compose1 (map-cstream-next sqr) (filter-cstream-next odd?) list->cstream-next)) - lst))) + (apply identity args)))) values) "deforestation in arbitrary positions")) (let ([stx (map make-right-chiral (syntax->list #`(values - #,(cons 'thread (map make-right-chiral - (syntax->list - #'((#%partial-application - ((#%host-expression filter) - (#%host-expression odd?))) - (#%partial-application - ((#%host-expression map) - (#%host-expression sqr))))))))))]) + (thread + #,@(map make-right-chiral + (syntax->list + #'((#%partial-application + ((#%host-expression filter) + (#%host-expression odd?))) + (#%partial-application + ((#%host-expression map) + (#%host-expression sqr))))))))))]) (check-equal? (syntax->datum (deforest-rewrite #`(thread #,@stx))) @@ -108,15 +112,15 @@ #`(thread #,@stx))) '(thread (esc - (λ (lst) - ((foldl-cstream + (λ args + ((foldl-cstream-next string-append "I" (inline-compose1 (filter-cstream-next string-upcase) list->cstream-next)) - lst)))) + (apply identity args))))) "deforestation in arbitrary positions"))) (test-suite "fixed point" From 5fc615b882c8b2fb754c7db90b49d2de2b63f04f Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 16:51:50 -0800 Subject: [PATCH 07/16] remove outdated compiler rewrite rule --- qi-lib/flow/core/compiler.rkt | 3 --- 1 file changed, 3 deletions(-) diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index 102ea12e..1bfc5306 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -45,9 +45,6 @@ ;; call to the optimizer ;; TODO: eliminate outdated rules here (syntax-parse stx - ;; restorative optimization for "all" - [((~datum thread) ((~datum amp) onex) (~datum AND)) - #`(esc (give (curry andmap #,(compile-flow #'onex))))] ;; "deforestation" for values ;; (~> (pass f) (>< g)) → (>< (if f g ⏚)) [((~datum thread) _0 ... ((~datum pass) f) ((~datum amp) g) _1 ...) From 693ebab1ee1c571c71646c7f3ac18a1f83783ecf Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 17:10:43 -0800 Subject: [PATCH 08/16] normalization rule to collapse `values` inside a threading form --- qi-lib/flow/core/compiler.rkt | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index 1bfc5306..1c16ac17 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -88,7 +88,12 @@ ;; and we can only know this at runtime. [((~datum thread) _0 ... (~datum collect) (~datum sep) _1 ...) #'(thread _0 ... _1 ...)] - ;; return syntax unchanged if there are no known optimizations + ;; collapse `values` and `_` inside a threading form + [((~datum thread) _0 ... (~literal values) _1 ...) + #'(thread _0 ... _1 ...)] + [((~datum thread) _0 ... (~datum _) _1 ...) + #'(thread _0 ... _1 ...)] + ;; return syntax unchanged if there are no applicable normalizations [_ stx])) ;; Applies f repeatedly to the init-val terminating the loop if the From 317173f6d90b64e816fb0b29ca040849f45979d8 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Fri, 17 Nov 2023 17:37:29 -0800 Subject: [PATCH 09/16] Add initial tests for the normalization pass This uses the approach of independently normalizing two expressions we expect to be equivalent, and comparing the results for equality. This allows us to avoid dealing with the intricacies of the normalized output in our tests while still making useful and sufficient assertions about it. The approach was suggested by Sam and Gus on Discourse: https://racket.discourse.group/t/best-practices-for-testing-compiler-optimizations/2369 --- qi-lib/flow/core/compiler.rkt | 11 ++++--- qi-test/tests/compiler.rkt | 56 ++++++++++++++++------------------- 2 files changed, 32 insertions(+), 35 deletions(-) diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index 1c16ac17..fbdc04a2 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -1,9 +1,7 @@ #lang racket/base (provide (for-syntax compile-flow - ;; TODO: only used in unit tests, maybe try - ;; using a submodule to avoid providing these usually - deforest-rewrite)) + normalize-pass)) (require (for-syntax racket/base syntax/parse @@ -28,6 +26,11 @@ (emit-local-step stx0 stx1 #:id #'name) stx1)) + ;; TODO: move this to a common utils module for use in all + ;; modules implementing optimization passes + ;; Also, resolve + ;; "syntax-local-expand-observer: not currently expanding" + ;; issue encountered in running compiler unit tests (define-syntax-rule (define-qi-expansion-step (name stx0) body ...) (define (name stx0) @@ -39,7 +42,7 @@ (define (compile-flow stx) (process-bindings (optimize-flow stx))) - (define-qi-expansion-step (normalize-rewrite stx) + (define (normalize-rewrite stx) ;; TODO: the "active" components of the expansions should be ;; optimized, i.e. they should be wrapped with a recursive ;; call to the optimizer diff --git a/qi-test/tests/compiler.rkt b/qi-test/tests/compiler.rkt index 261e7d3c..2ab721eb 100644 --- a/qi-test/tests/compiler.rkt +++ b/qi-test/tests/compiler.rkt @@ -2,20 +2,27 @@ (provide tests) -(require (for-template qi/flow/core/deforest) +(require (for-template qi/flow/core/deforest + qi/flow/core/compiler) (only-in qi/flow/extended/syntax make-right-chiral) rackunit rackunit/text-ui (only-in math sqr)) +(define-syntax-rule (test-normalize a b msg) + (check-equal? (syntax->datum + (normalize-pass a)) + (syntax->datum + (normalize-pass b)) + msg)) + (define tests (test-suite "compiler tests" (test-suite "deforestation" - ;; (~>> values (filter odd?) (map sqr) values) (let ([stx (map make-right-chiral (syntax->list #'((#%partial-application ((#%host-expression filter) @@ -42,6 +49,7 @@ #`(thread #,stx))) '(thread (#%partial-application ((#%host-expression map) (#%host-expression sqr)))) "does not deforest map in the head position")) + ;; (~>> values (filter odd?) (map sqr) values) (let ([stx (map make-right-chiral (syntax->list #'(values @@ -69,35 +77,6 @@ (apply identity args)))) values) "deforestation in arbitrary positions")) - (let ([stx (map make-right-chiral - (syntax->list - #`(values - (thread - #,@(map make-right-chiral - (syntax->list - #'((#%partial-application - ((#%host-expression filter) - (#%host-expression odd?))) - (#%partial-application - ((#%host-expression map) - (#%host-expression sqr))))))))))]) - (check-equal? (syntax->datum - (deforest-rewrite - #`(thread #,@stx))) - '(thread - values - (esc - (λ (lst) - ((cstream->list - (inline-compose1 - (map-cstream-next - sqr) - (filter-cstream-next - odd?) - list->cstream-next)) - lst))) - values) - "deforestation in nested positions")) (let ([stx (map make-right-chiral (syntax->list #'((#%partial-application @@ -122,6 +101,21 @@ list->cstream-next)) (apply identity args))))) "deforestation in arbitrary positions"))) + (test-suite + "normalization" + (test-normalize #'(thread + (thread (filter odd?) + (map sqr))) + #'(thread (filter odd?) + (map sqr)) + "nested threads are collapsed") + (test-normalize #'(thread values + sqr) + #'(thread sqr) + "values inside threading is elided") + (test-normalize #'(thread sqr) + #'sqr + "trivial threading is collapsed")) (test-suite "fixed point" null))) From 429f93bee6394651f868ac85387d8ad4d117fc84 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 20 Nov 2023 12:25:42 -0800 Subject: [PATCH 10/16] improve `range-map-sum` benchmark --- qi-sdk/profile/nonlocal/qi/main.rkt | 5 +---- qi-sdk/profile/nonlocal/racket/main.rkt | 5 +---- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/qi-sdk/profile/nonlocal/qi/main.rkt b/qi-sdk/profile/nonlocal/qi/main.rkt index 21c799bc..f6311a18 100644 --- a/qi-sdk/profile/nonlocal/qi/main.rkt +++ b/qi-sdk/profile/nonlocal/qi/main.rkt @@ -94,11 +94,8 @@ ;; (filter (λ (v) (< v 10))) ;; (map sqr))) -(define (~sum vs) - (apply + vs)) - (define-flow range-map-sum - (~>> (range 1) (map sqr) ~sum)) + (~>> (range 0) (map sqr) (foldr + 0))) ;; (define filter-double ;; (map (☯ (when odd? diff --git a/qi-sdk/profile/nonlocal/racket/main.rkt b/qi-sdk/profile/nonlocal/racket/main.rkt index 52546204..1f942b12 100644 --- a/qi-sdk/profile/nonlocal/racket/main.rkt +++ b/qi-sdk/profile/nonlocal/racket/main.rkt @@ -75,11 +75,8 @@ (apply values (map sqr (filter odd? vs)))) -(define (~sum vs) - (apply + vs)) - (define (range-map-sum n) - (~sum (map sqr (range 1 n)))) + (apply + (map sqr (range 0 n)))) (define (double-list lst) (apply append (map (λ (v) (list v v)) lst))) From 8fd4e2fde68514128a02f63a5e8b1490b0c5da21 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 20 Nov 2023 12:30:45 -0800 Subject: [PATCH 11/16] add a "long functional pipeline" benchmark --- qi-sdk/profile/nonlocal/qi/main.rkt | 15 +++++++++------ qi-sdk/profile/nonlocal/racket/main.rkt | 11 +++++++++++ qi-sdk/profile/nonlocal/spec.rkt | 3 +++ qi-sdk/profile/util.rkt | 3 +++ 4 files changed, 26 insertions(+), 6 deletions(-) diff --git a/qi-sdk/profile/nonlocal/qi/main.rkt b/qi-sdk/profile/nonlocal/qi/main.rkt index f6311a18..1581dd11 100644 --- a/qi-sdk/profile/nonlocal/qi/main.rkt +++ b/qi-sdk/profile/nonlocal/qi/main.rkt @@ -16,6 +16,7 @@ filter-map filter-map-foldr filter-map-foldl + long-functional-pipeline filter-map-values range-map-sum double-list @@ -87,12 +88,14 @@ (~>> (range 0) (map sqr))) -;; (define-flow filter-map -;; (~>> (filter odd?) -;; (map sqr) -;; identity -;; (filter (λ (v) (< v 10))) -;; (map sqr))) +(define-flow long-functional-pipeline + (~>> (range 0) + (filter odd?) + (map sqr) + values + (filter (λ (v) (< (remainder v 10) 5))) + (map (λ (v) (* 2 v))) + (foldl + 0))) (define-flow range-map-sum (~>> (range 0) (map sqr) (foldr + 0))) diff --git a/qi-sdk/profile/nonlocal/racket/main.rkt b/qi-sdk/profile/nonlocal/racket/main.rkt index 1f942b12..76f461ac 100644 --- a/qi-sdk/profile/nonlocal/racket/main.rkt +++ b/qi-sdk/profile/nonlocal/racket/main.rkt @@ -11,6 +11,7 @@ filter-map filter-map-foldr filter-map-foldl + long-functional-pipeline filter-map-values range-map-sum double-list @@ -71,6 +72,16 @@ (define (filter-map-foldl lst) (foldl + 0 (map sqr (filter odd? lst)))) +(define (long-functional-pipeline v) + (foldl + + 0 + (map (λ (v) (* 2 v)) + (filter (λ (v) (< (remainder v 10) 5)) + (values + (map sqr + (filter odd? + (range 0 v)))))))) + (define (filter-map-values . vs) (apply values (map sqr (filter odd? vs)))) diff --git a/qi-sdk/profile/nonlocal/spec.rkt b/qi-sdk/profile/nonlocal/spec.rkt index d1a76f5b..c8a7c38d 100644 --- a/qi-sdk/profile/nonlocal/spec.rkt +++ b/qi-sdk/profile/nonlocal/spec.rkt @@ -35,6 +35,9 @@ (bm "filter-map-foldl" check-large-list 50000) + (bm "long-functional-pipeline" + check-value-large + 5000) (bm "range-map-sum" check-value-large 5000) diff --git a/qi-sdk/profile/util.rkt b/qi-sdk/profile/util.rkt index b831bd1e..27a0be0e 100644 --- a/qi-sdk/profile/util.rkt +++ b/qi-sdk/profile/util.rkt @@ -5,6 +5,7 @@ check-value check-value-medium-large check-value-large + check-value-very-large check-list check-large-list check-values @@ -63,6 +64,8 @@ (define check-value-large (curryr check-value #(1000))) +(define check-value-very-large (curryr check-value #(100000))) + ;; This uses the same list input each time. Not sure if that ;; may end up being cached at some level and thus obfuscate ;; the results? On the other hand, From e6db41c1008d8dcf10817fa881affe449947825e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 20 Nov 2023 12:36:26 -0800 Subject: [PATCH 12/16] remove unused code --- qi-sdk/profile/nonlocal/qi/main.rkt | 8 -------- 1 file changed, 8 deletions(-) diff --git a/qi-sdk/profile/nonlocal/qi/main.rkt b/qi-sdk/profile/nonlocal/qi/main.rkt index 1581dd11..ab0a52ad 100644 --- a/qi-sdk/profile/nonlocal/qi/main.rkt +++ b/qi-sdk/profile/nonlocal/qi/main.rkt @@ -1,10 +1,5 @@ #lang racket/base -(require racket/match - racket/function) - -(require racket/performance-hint) - (provide conditionals composition root-mean-square @@ -67,9 +62,6 @@ ;; (define-flow filter-map ;; (~> △ (>< (if odd? sqr ⏚)) ▽)) -;; (define-flow filter-map -;; (~>> (filter odd?) (map sqr))) - (define-flow filter-map (~>> (filter odd?) (map sqr))) From e3231ffccac58a770b27ae658705df8c4e336496 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 20 Nov 2023 12:55:44 -0800 Subject: [PATCH 13/16] Replace `range-map` benchmark with `range-map-car` This will be more useful, e.g. to compare against `range-map-sum` which must consume the entire stream. --- qi-sdk/profile/nonlocal/qi/main.rkt | 13 +++++++------ qi-sdk/profile/nonlocal/racket/main.rkt | 14 +++++++------- qi-sdk/profile/nonlocal/spec.rkt | 2 +- 3 files changed, 15 insertions(+), 14 deletions(-) diff --git a/qi-sdk/profile/nonlocal/qi/main.rkt b/qi-sdk/profile/nonlocal/qi/main.rkt index ab0a52ad..2f919ba6 100644 --- a/qi-sdk/profile/nonlocal/qi/main.rkt +++ b/qi-sdk/profile/nonlocal/qi/main.rkt @@ -7,7 +7,7 @@ pingala eratosthenes collatz - range-map + range-map-car filter-map filter-map-foldr filter-map-foldl @@ -76,9 +76,13 @@ (map sqr) (foldl + 0))) -(define-flow range-map +(define-flow range-map-car (~>> (range 0) - (map sqr))) + (map sqr) + car)) + +(define-flow range-map-sum + (~>> (range 0) (map sqr) (foldr + 0))) (define-flow long-functional-pipeline (~>> (range 0) @@ -89,9 +93,6 @@ (map (λ (v) (* 2 v))) (foldl + 0))) -(define-flow range-map-sum - (~>> (range 0) (map sqr) (foldr + 0))) - ;; (define filter-double ;; (map (☯ (when odd? ;; (-< _ _))) diff --git a/qi-sdk/profile/nonlocal/racket/main.rkt b/qi-sdk/profile/nonlocal/racket/main.rkt index 76f461ac..89769805 100644 --- a/qi-sdk/profile/nonlocal/racket/main.rkt +++ b/qi-sdk/profile/nonlocal/racket/main.rkt @@ -7,7 +7,7 @@ pingala eratosthenes collatz - range-map + range-map-car filter-map filter-map-foldr filter-map-foldl @@ -60,9 +60,6 @@ [(odd? n) (cons n (collatz (+ (* 3 n) 1)))] [(even? n) (cons n (collatz (quotient n 2)))])) -(define (range-map v) - (map sqr (range 0 v))) - (define (filter-map lst) (map sqr (filter odd? lst))) @@ -72,6 +69,12 @@ (define (filter-map-foldl lst) (foldl + 0 (map sqr (filter odd? lst)))) +(define (range-map-car v) + (car (map sqr (range 0 v)))) + +(define (range-map-sum n) + (apply + (map sqr (range 0 n)))) + (define (long-functional-pipeline v) (foldl + 0 @@ -86,9 +89,6 @@ (apply values (map sqr (filter odd? vs)))) -(define (range-map-sum n) - (apply + (map sqr (range 0 n)))) - (define (double-list lst) (apply append (map (λ (v) (list v v)) lst))) diff --git a/qi-sdk/profile/nonlocal/spec.rkt b/qi-sdk/profile/nonlocal/spec.rkt index c8a7c38d..eb7b5388 100644 --- a/qi-sdk/profile/nonlocal/spec.rkt +++ b/qi-sdk/profile/nonlocal/spec.rkt @@ -20,7 +20,7 @@ (bm "root-mean-square" check-list 500000) - (bm "range-map" + (bm "range-map-car" check-value-large 50000) (bm "filter-map" From 7b6f04e1a1db3965696eb940a8e2a768c28b099f Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 20 Nov 2023 13:19:53 -0800 Subject: [PATCH 14/16] failing unit test for range-map-car --- qi-test/tests/flow.rkt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt index aa1a8397..32b327e8 100644 --- a/qi-test/tests/flow.rkt +++ b/qi-test/tests/flow.rkt @@ -1546,7 +1546,10 @@ "ABCI") (check-equal? ((☯ (~>> (map string-upcase) (foldl string-append "I"))) (list "a" "b" "c")) - "CBAI"))))) + "CBAI") + (check-equal? ((☯ (~>> (range 10) (map sqr) car)) + 0) + 0))))) (module+ main (void (run-tests tests))) From 2b347fa8ce4c69d6e2a8e0e3f2b23f4b340efd58 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 20 Nov 2023 13:51:29 -0800 Subject: [PATCH 15/16] Refactor normalize pass into its own module --- qi-lib/flow/core/compiler.rkt | 60 ++----------------------------- qi-lib/flow/core/normalize.rkt | 66 ++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+), 58 deletions(-) create mode 100644 qi-lib/flow/core/normalize.rkt diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt index fbdc04a2..31a2a94c 100644 --- a/qi-lib/flow/core/compiler.rkt +++ b/qi-lib/flow/core/compiler.rkt @@ -16,7 +16,8 @@ racket/undefined (prefix-in fancy: fancy-app) racket/list - "deforest.rkt") + "deforest.rkt" + "normalize.rkt") (begin-for-syntax @@ -42,63 +43,6 @@ (define (compile-flow stx) (process-bindings (optimize-flow stx))) - (define (normalize-rewrite stx) - ;; TODO: the "active" components of the expansions should be - ;; optimized, i.e. they should be wrapped with a recursive - ;; call to the optimizer - ;; TODO: eliminate outdated rules here - (syntax-parse stx - ;; "deforestation" for values - ;; (~> (pass f) (>< g)) → (>< (if f g ⏚)) - [((~datum thread) _0 ... ((~datum pass) f) ((~datum amp) g) _1 ...) - #'(thread _0 ... (amp (if f g ground)) _1 ...)] - ;; merge amps in sequence - [((~datum thread) _0 ... ((~datum amp) f) ((~datum amp) g) _1 ...) - #`(thread _0 ... #,(normalize-rewrite #'(amp (thread f g))) _1 ...)] - ;; merge pass filters in sequence - [((~datum thread) _0 ... ((~datum pass) f) ((~datum pass) g) _1 ...) - #'(thread _0 ... (pass (and f g)) _1 ...)] - ;; collapse deterministic conditionals - [((~datum if) (~datum #t) f g) #'f] - [((~datum if) (~datum #f) f g) #'g] - ;; trivial threading form - [((~datum thread) f) - #'f] - ;; associative laws for ~> - [((~datum thread) _0 ... ((~datum thread) f ...) _1 ...) ; note: greedy matching - #'(thread _0 ... f ... _1 ...)] - ;; left and right identity for ~> - [((~datum thread) _0 ... (~datum _) _1 ...) - #'(thread _0 ... _1 ...)] - ;; composition of identity flows is the identity flow - [((~datum thread) (~datum _) ...) - #'_] - ;; identity flows composed using a relay - [((~datum relay) (~datum _) ...) - #'_] - ;; amp and identity - [((~datum amp) (~datum _)) - #'_] - ;; trivial tee junction - [((~datum tee) f) - #'f] - ;; merge adjacent gens - [((~datum tee) _0 ... ((~datum gen) a ...) ((~datum gen) b ...) _1 ...) - #'(tee _0 ... (gen a ... b ...) _1 ...)] - ;; prism identities - ;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's - ;; only valid if the input is in fact a list, and is an error otherwise, - ;; and we can only know this at runtime. - [((~datum thread) _0 ... (~datum collect) (~datum sep) _1 ...) - #'(thread _0 ... _1 ...)] - ;; collapse `values` and `_` inside a threading form - [((~datum thread) _0 ... (~literal values) _1 ...) - #'(thread _0 ... _1 ...)] - [((~datum thread) _0 ... (~datum _) _1 ...) - #'(thread _0 ... _1 ...)] - ;; return syntax unchanged if there are no applicable normalizations - [_ stx])) - ;; Applies f repeatedly to the init-val terminating the loop if the ;; result of f is #f or the new syntax object is eq? to the previous ;; (possibly initial) one. diff --git a/qi-lib/flow/core/normalize.rkt b/qi-lib/flow/core/normalize.rkt new file mode 100644 index 00000000..54f47b73 --- /dev/null +++ b/qi-lib/flow/core/normalize.rkt @@ -0,0 +1,66 @@ +#lang racket/base + +(provide (for-syntax normalize-rewrite)) + +(require (for-syntax racket/base + syntax/parse)) + +(begin-for-syntax + + ;; 0. "Qi-normal form" + (define (normalize-rewrite stx) + ;; TODO: the "active" components of the expansions should be + ;; optimized, i.e. they should be wrapped with a recursive + ;; call to the optimizer + ;; TODO: eliminate outdated rules here + (syntax-parse stx + ;; "deforestation" for values + ;; (~> (pass f) (>< g)) → (>< (if f g ⏚)) + [((~datum thread) _0 ... ((~datum pass) f) ((~datum amp) g) _1 ...) + #'(thread _0 ... (amp (if f g ground)) _1 ...)] + ;; merge amps in sequence + [((~datum thread) _0 ... ((~datum amp) f) ((~datum amp) g) _1 ...) + #`(thread _0 ... #,(normalize-rewrite #'(amp (thread f g))) _1 ...)] + ;; merge pass filters in sequence + [((~datum thread) _0 ... ((~datum pass) f) ((~datum pass) g) _1 ...) + #'(thread _0 ... (pass (and f g)) _1 ...)] + ;; collapse deterministic conditionals + [((~datum if) (~datum #t) f g) #'f] + [((~datum if) (~datum #f) f g) #'g] + ;; trivial threading form + [((~datum thread) f) + #'f] + ;; associative laws for ~> + [((~datum thread) _0 ... ((~datum thread) f ...) _1 ...) ; note: greedy matching + #'(thread _0 ... f ... _1 ...)] + ;; left and right identity for ~> + [((~datum thread) _0 ... (~datum _) _1 ...) + #'(thread _0 ... _1 ...)] + ;; composition of identity flows is the identity flow + [((~datum thread) (~datum _) ...) + #'_] + ;; identity flows composed using a relay + [((~datum relay) (~datum _) ...) + #'_] + ;; amp and identity + [((~datum amp) (~datum _)) + #'_] + ;; trivial tee junction + [((~datum tee) f) + #'f] + ;; merge adjacent gens + [((~datum tee) _0 ... ((~datum gen) a ...) ((~datum gen) b ...) _1 ...) + #'(tee _0 ... (gen a ... b ...) _1 ...)] + ;; prism identities + ;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's + ;; only valid if the input is in fact a list, and is an error otherwise, + ;; and we can only know this at runtime. + [((~datum thread) _0 ... (~datum collect) (~datum sep) _1 ...) + #'(thread _0 ... _1 ...)] + ;; collapse `values` and `_` inside a threading form + [((~datum thread) _0 ... (~literal values) _1 ...) + #'(thread _0 ... _1 ...)] + [((~datum thread) _0 ... (~datum _) _1 ...) + #'(thread _0 ... _1 ...)] + ;; return syntax unchanged if there are no applicable normalizations + [_ stx]))) From 51faf398720d40e5f3f606d7ea0a9bff76d8271e Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Mon, 20 Nov 2023 13:57:33 -0800 Subject: [PATCH 16/16] note a todo for normalization, and remove an outdated comment --- qi-lib/flow/core/normalize.rkt | 3 --- qi-sdk/profile/nonlocal/qi/main.rkt | 3 +++ 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/qi-lib/flow/core/normalize.rkt b/qi-lib/flow/core/normalize.rkt index 54f47b73..83c6584f 100644 --- a/qi-lib/flow/core/normalize.rkt +++ b/qi-lib/flow/core/normalize.rkt @@ -9,9 +9,6 @@ ;; 0. "Qi-normal form" (define (normalize-rewrite stx) - ;; TODO: the "active" components of the expansions should be - ;; optimized, i.e. they should be wrapped with a recursive - ;; call to the optimizer ;; TODO: eliminate outdated rules here (syntax-parse stx ;; "deforestation" for values diff --git a/qi-sdk/profile/nonlocal/qi/main.rkt b/qi-sdk/profile/nonlocal/qi/main.rkt index 2f919ba6..7d9f154a 100644 --- a/qi-sdk/profile/nonlocal/qi/main.rkt +++ b/qi-sdk/profile/nonlocal/qi/main.rkt @@ -82,6 +82,9 @@ car)) (define-flow range-map-sum + ;; 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))) (define-flow long-functional-pipeline