Skip to content

Commit

Permalink
A few basic tests for deforested forms
Browse files Browse the repository at this point in the history
  • Loading branch information
@countvajhula
countvajhula committed Jul 12, 2024
1 parent 1e73acd commit 0c51307
Show file tree
Hide file tree
Showing 3 changed files with 233 additions and 63 deletions.
205 changes: 144 additions & 61 deletions qi-test/tests/compiler/rules/deforest.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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"
Expand All @@ -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
Expand Down
36 changes: 34 additions & 2 deletions qi-test/tests/compiler/rules/private/deforest-util.rkt
View file
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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"))
55 changes: 55 additions & 0 deletions qi-test/tests/compiler/semantics.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@
(only-in math sqr)
qi/list
syntax/macro-testing
racket/string
racket/function)

(define tests
Expand Down Expand Up @@ -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"
Expand Down

0 comments on commit 0c51307

Please sign in to comment.