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]) [gc : Number])
'whatever)) 'whatever))
#:ret (ret (-val 'whatever) (-FS (list) (list (make-Bot))))] #: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 (test-suite
"check-type tests" "check-type tests"

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

@ -77,8 +77,9 @@
-Output-Port)] -Output-Port)]
[read (->opt [-Input-Port] -Sexp)] [read (->opt [-Input-Port] -Sexp)]
[ormap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))] [ormap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
[andmap (-polydots (a c b) (cl->* [andmap (-polydots (a c d b) (cl->*
;(make-pred-ty (list (make-pred-ty (list a) B d) (-lst a)) B (-lst d)) ;; 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)))] (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c)))]
[newline (->opt [-Output-Port] -Void)] [newline (->opt [-Output-Port] -Void)]
[not (-> Univ B)] [not (-> Univ B)]

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

@ -128,7 +128,7 @@
body2] body2]
[_ (let ([ty-str (match type [_ (let ([ty-str (match type
[(tc-result1: (? (lambda (t) (type-equal? t -Void)))) #f] [(tc-result1: (? (lambda (t) (type-equal? t -Void)))) #f]
[(tc-result1: t) [(tc-result1: t f o)
(format "- : ~a\n" t)] (format "- : ~a\n" t)]
[(tc-results: t) [(tc-results: t)
(format "- : ~a\n" (cons 'Values 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 (d/c make-pred-ty
(case-> (c:-> Type/c Type/c) (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 (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 t)
(->* in out : (-LFS (list (-filter t)) (list (-not-filter t))))] (make-pred-ty in out t 0)]
[(t) (make-pred-ty (list Univ) -Boolean t)])) [(t) (make-pred-ty (list Univ) -Boolean t 0)]))
(define true-filter (-FS (list) (list (make-Bot)))) (define true-filter (-FS (list) (list (make-Bot))))
(define false-filter (-FS (list (make-Bot)) (list))) (define false-filter (-FS (list (make-Bot)) (list)))