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

`andmap' now works as a predicate in Typed Scheme

Browse Source 
svn: r17575
This commit is contained in:
Sam Tobin-Hochstadt 2010-01-08 19:05:58 +00:00
parent c8c66bfe7f
commit f13453e889
4 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/typed-scheme/unit-tests/typecheck-tests.ss
View File

@ -782,6 +782,11 @@
[gc : Number])
'whatever))
#:ret (ret (-val 'whatever) (-FS (list) (list (make-Bot))))]
[tc-e (let: ([l : (Listof Any) (list 1 2 3)])
(if (andmap number? l)
(+ 1 (car l))
7))
-Number]
)
(test-suite
"check-type tests"

5
collects/typed-scheme/private/base-env.ss
View File

@ -77,8 +77,9 @@
-Output-Port)]
[read (->opt [-Input-Port] -Sexp)]
[ormap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
[andmap (-polydots (a c b) (cl->*
;(make-pred-ty (list (make-pred-ty (list a) B d) (-lst a)) B (-lst d))
[andmap (-polydots (a c d b) (cl->*
;; 1 means predicate on second argument
(make-pred-ty (list (make-pred-ty (list a) c d) (-lst a)) c (-lst d) 1)
(->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c)))]
[newline (->opt [-Output-Port] -Void)]
[not (-> Univ B)]

2
collects/typed-scheme/typed-scheme.ss
View File

@ -128,7 +128,7 @@
body2]
[_ (let ([ty-str (match type
[(tc-result1: (? (lambda (t) (type-equal? t -Void)))) #f]
[(tc-result1: t)
[(tc-result1: t f o)
(format "- : ~a\n" t)]
[(tc-results: t)
(format "- : ~a\n" (cons 'Values t))]

9
collects/typed-scheme/types/abbrev.ss
View File

@ -252,11 +252,14 @@
(d/c make-pred-ty
(case-> (c:-> Type/c Type/c)
(c:-> (listof Type/c) Type/c Type/c Type/c))
(c:-> (listof Type/c) Type/c Type/c Type/c)
(c:-> (listof Type/c) Type/c Type/c integer? Type/c))
(case-lambda
[(in out t n)
(->* in out : (-LFS (list (-filter t null n)) (list (-not-filter t null n))))]
[(in out t)
(->* in out : (-LFS (list (-filter t)) (list (-not-filter t))))]
[(t) (make-pred-ty (list Univ) -Boolean t)]))
(make-pred-ty in out t 0)]
[(t) (make-pred-ty (list Univ) -Boolean t 0)]))
(define true-filter (-FS (list) (list (make-Bot))))
(define false-filter (-FS (list (make-Bot)) (list)))