Allow objects to be specified in ->

Fix overlap to handle overlapping base types (numbers)

svn: r14781

original commit: 7b4081eef114343991472b0839e336d35301802a
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-12 15:13:17 +00:00
parent 937ac8309a
commit d7d9932f89
3 changed files with 5 additions and 5 deletions

View File

@ -96,8 +96,8 @@
(-> LatentFilter/c Type/c Object? (or/c '() (list/c Filter/c)))
(match* (lf s o)
[((LBot:) _ _) (list (make-Bot))]
[((LNotTypeFilter: (? (lambda (t) (subtype s t))) (list) _) _ _) (list (make-Bot))]
[((LTypeFilter: (? (lambda (t) (not (overlap s t)))) (list) _) _ _) (list (make-Bot))]
[((LNotTypeFilter: (? (lambda (t) (subtype s t)) t) (list) _) _ _) (list (make-Bot))]
[((LTypeFilter: (? (lambda (t) (not (overlap s t))) t) (list) _) _ _) (list (make-Bot))]
[(_ _ (Empty:)) null]
[((LTypeFilter: t pi* _) _ (Path: pi x)) (list (make-TypeFilter t (append pi* pi) x))]
[((LNotTypeFilter: t pi* _) _ (Path: pi x)) (list (make-NotTypeFilter t (append pi* pi) x))]))

View File

@ -191,8 +191,8 @@
(define-syntax-class c
(pattern x:id #:when (eq? ': (syntax-e #'x))))
(syntax-parse stx
[(_ dom ... rng :c filters)
#'(->* (list dom ...) rng : filters)]
[(_ dom ... rng _:c filters _:c objects)
#'(->* (list dom ...) rng : filters : objects)]
[(_ dom ... rng :c filters)
#'(->* (list dom ...) rng : filters)]
[(_ dom ... rng)

View File

@ -23,7 +23,7 @@
(ormap (lambda (t*) (overlap t t*)) e)]
[(or (list _ (? Poly?)) (list (? Poly?) _))
#t] ;; these can have overlap, conservatively
[(list (Base: s1 _) (Base: s2 _)) (eq? s1 s2)]
[(list (Base: s1 _) (Base: s2 _)) (or (subtype t1 t2) (subtype t2 t1))]
[(list (Base: _ _) (Value: _)) (subtype t2 t1)] ;; conservative
[(list (Value: _) (Base: _ _)) (subtype t1 t2)] ;; conservative
[(list (Syntax: t) (Syntax: t*))