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

Fix implied-atomic to work on -top and -bot.

Browse Source
This commit is contained in:
Eric Dobson 2014-03-14 18:54:50 -07:00
parent f7536ebfbd
commit 9e2787c0cf
2 changed files with 21 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -36,20 +36,21 @@
;; is f1 implied by f2? ;; is f1 implied by f2?
(define (implied-atomic? f1 f2) (define (implied-atomic? f1 f2)
(if (filter-equal? f1 f2) (match* (f1 f2)
#t [(f f) #t]
(match* (f1 f2) [((Top:) _) #t]
[((OrFilter: fs) f2) [(_ (Bot:)) #t]
(memf (lambda (f) (filter-equal? f f2)) fs)] [((OrFilter: fs) f2)
[((TypeFilter: t1 p1 i1) (memf (lambda (f) (filter-equal? f f2)) fs)]
(TypeFilter: t2 p1 i2)) [((TypeFilter: t1 p1 i1)
(and (name-ref=? i1 i2) (TypeFilter: t2 p1 i2))
(subtype t2 t1))] (and (name-ref=? i1 i2)
[((NotTypeFilter: t2 p1 i2) (subtype t2 t1))]
(NotTypeFilter: t1 p1 i1)) [((NotTypeFilter: t2 p1 i2)
(and (name-ref=? i1 i2) (NotTypeFilter: t1 p1 i1))
(subtype t2 t1))] (and (name-ref=? i1 i2)
[(_ _) #f]))) (subtype t2 t1))]
[(_ _) #f]))
(define (hash-name-ref i) (define (hash-name-ref i)
(if (identifier? i) (hash-id i) i)) (if (identifier? i) (hash-id i) i))

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

@ -39,8 +39,14 @@
-top -top) -top -top)
(check implied-atomic? (check implied-atomic?
-bot -bot) -bot -bot)
(check implied-atomic?
-top -bot)
(check not-implied-atomic? (check not-implied-atomic?
-bot -top) -bot -top)
(check implied-atomic?
-top (-filter -Symbol 0))
(check implied-atomic?
(-filter -Symbol 0) -bot)
(check implied-atomic? (check implied-atomic?
(-filter (Un -String -Symbol) 0) (-filter (Un -String -Symbol) 0)
(-filter -Symbol 0)) (-filter -Symbol 0))