Skip to content

Commit

Permalink
Update deforestation rules tests
Browse files Browse the repository at this point in the history 
- 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?)
  • Loading branch information
@countvajhula
countvajhula committed Aug 9, 2024
1 parent 625cda8 commit 716a68a
Showing 1 changed file with 56 additions and 102 deletions.
158 changes: 56 additions & 102 deletions qi-test/tests/compiler/rules/deforest.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 716a68a

Please sign in to comment.