suzanne.soy/typed-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 
original commit: 7f721ef5d87dcc9b1eb1f447a94b087e8d3c647b
This commit is contained in:
Eric Dobson 2014-06-20 22:32:44 -07:00
parent 8013ad6e43
commit 259ab755d0
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 f fs) (loop fs (cons f results))])))
;; Move all the type filters up front as they are the stronger props
(define-values (f-args other-args)
(partition TypeFilter? (flatten-ands (remove-duplicates args eq? #:key Rep-seq))))
(let loop ([fs (append f-args other-args)] [result null])
(define-values (filters other-args)
(partition (λ (f) (or (TypeFilter? f) (NotTypeFilter? f)))
(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)
(match result
[(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))
(check-equal?
(-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)))
))