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

`member' can now be used a predicate.

Browse Source 
svn: r17554

original commit: b7f989943931dbd7aec58f238a9e9c66c1142f3b
This commit is contained in:
Sam Tobin-Hochstadt 2010-01-07 22:11:54 +00:00
parent cffc0e2563
commit e0ceba24a8
2 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/typed-scheme/succeed/member-pred.ss Normal file
View File

@ -0,0 +1,8 @@
#lang typed/scheme
(: foo : Any -> (U 'x 'y))
(define (foo x)
(if (member x '(x y))
x
'x))

14
collects/typed-scheme/typecheck/tc-app.ss
View File

@ -32,11 +32,10 @@
;; comparators that inform the type system
(define-syntax-class comparator
#:literals (eq? equal? eqv? = string=? symbol=?)
(pattern eq?) (pattern equal?) (pattern eqv?) (pattern =) (pattern string=?) (pattern symbol=?))
#:literals (eq? equal? eqv? = string=? symbol=? memq member)
(pattern eq?) (pattern equal?) (pattern eqv?) (pattern =) (pattern string=?) (pattern symbol=?) (pattern member))
;; typecheck eq? applications
;; identifier identifier expression expression expression
;; identifier expr expr -> tc-results
(define (tc/eq comparator v1 v2)
(define (ok? val)
@ -52,6 +51,15 @@
(ret -Boolean (apply-filter (make-LFilterSet (list (make-LTypeFilter (-val val) null 0)) (list (make-LNotTypeFilter (-val val) null 0))) t o))]
[((tc-result1: (Value: (? ok? val))) (tc-result1: t _ o))
(ret -Boolean (apply-filter (make-LFilterSet (list (make-LTypeFilter (-val val) null 0)) (list (make-LNotTypeFilter (-val val) null 0))) t o))]
[((tc-result1: t _ o)
(and (? (lambda _ (free-identifier=? #'member comparator)))
(tc-result1: (app untuple (list ts ...)))))
(let ([ty (apply Un ts)])
(ret -Boolean
(apply-filter
(make-LFilterSet (list (make-LTypeFilter ty null 0))
(list (make-LNotTypeFilter ty null 0)))
t o)))]
[(_ _) (ret -Boolean)]))