suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

In -and move the NotTypeFilters to the begining as well.

Browse Source
This commit is contained in:
Eric Dobson 2014-06-20 22:32:44 -07:00
parent dcb5b09a14
commit 7f721ef5d8
2 changed files with 20 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/filter-ops.rkt
View File

@ -187,9 +187,12 @@
[(cons (AndFilter: fs*) fs) (loop fs (append fs* results))] [(cons (AndFilter: fs*) fs) (loop fs (append fs* results))]
[(cons f fs) (loop fs (cons f results))]))) [(cons f fs) (loop fs (cons f results))])))
;; Move all the type filters up front as they are the stronger props ;; Move all the type filters up front as they are the stronger props
(define-values (f-args other-args) (define-values (filters other-args)
(partition TypeFilter? (flatten-ands (remove-duplicates args eq? #:key Rep-seq)))) (partition (λ (f) (or (TypeFilter? f) (NotTypeFilter? f)))
(let loop ([fs (append f-args other-args)] [result null]) (flatten-ands (remove-duplicates args eq? #:key Rep-seq))))
(define-values (type-filters not-type-filters)
(partition TypeFilter? filters))
(let loop ([fs (append type-filters not-type-filters other-args)] [result null])
(if (null? fs) (if (null? fs)
(match result (match result
[(list) -top] [(list) -top]

15
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/filter-tests.rkt
View File

@ -131,5 +131,18 @@
(-filter -Symbol #'x)) (-filter -Symbol #'x))
(check-equal? (check-equal?
(-and (-not-filter (-val #f) #'x) (-filter -Symbol #'x)) (-and (-not-filter (-val #f) #'x) (-filter -Symbol #'x))
(-filter -Symbol #'x))) (-filter -Symbol #'x))
(check-equal?
(-and (-filter (-val #f) #'y)
(-or (-filter (-val #f) #'y)
(-filter (-val #f) #'x)))
(-filter (-val #f) #'y))
(check-equal?
(-and (-not-filter (-val #f) #'y)
(-or (-not-filter (-val #f) #'y)
(-not-filter (-val #f) #'x)))
(-not-filter (-val #f) #'y)))
)) ))