From 716a68a64def002e1c8cdf54c7e6b282e1454b63 Mon Sep 17 00:00:00 2001 From: Siddhartha Date: Thu, 8 Aug 2024 22:49:44 -0700 Subject: [PATCH] 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 11d67283..c211ebcd 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