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

Typecheck `map' expression, not just #'map.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-22 10:12:54 -04:00
parent 95c5f942e6
commit bce2cedf38
2 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -824,6 +824,8 @@
x x
(lambda (z) (eq? x z)))) (lambda (z) (eq? x z))))
(make-pred-ty (-val eof))] (make-pred-ty (-val eof))]
[tc-e ((inst map Number (Pairof Number Number)) car (ann (list (cons 1 2) (cons 2 3) (cons 4 5)) (Listof (Pairof Number Number))))
(-lst -Number)]
) )
(test-suite (test-suite
"check-type tests" "check-type tests"

4
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -625,7 +625,7 @@
(check-do-make-object #'cl #'args #'() #'())] (check-do-make-object #'cl #'args #'() #'())]
[(#%plain-app do-make-object cl (#%plain-app list . pos-args) (#%plain-app list (#%plain-app cons 'names named-args) ...)) [(#%plain-app do-make-object cl (#%plain-app list . pos-args) (#%plain-app list (#%plain-app cons 'names named-args) ...))
(check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...))] (check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...))]
[(#%plain-app (~literal map) f arg0 arg ...) [(#%plain-app (~and map-expr (~literal map)) f arg0 arg ...)
(match* ((single-value #'arg0) (map single-value (syntax->list #'(arg ...)))) (match* ((single-value #'arg0) (map single-value (syntax->list #'(arg ...))))
;; if the argument is a ListDots ;; if the argument is a ListDots
[((tc-result1: (ListDots: t0 bound0)) [((tc-result1: (ListDots: t0 bound0))
@ -646,7 +646,7 @@
"Expected one value, but got ~a" (-values ts))])] "Expected one value, but got ~a" (-values ts))])]
;; otherwise, if it's not a ListDots, defer to the regular function typechecking ;; otherwise, if it's not a ListDots, defer to the regular function typechecking
[(res0 res) [(res0 res)
(tc/funapp #'map #'(f arg0 arg ...) (single-value #'map) (list* (tc-expr #'f) res0 res) expected)])] (tc/funapp #'map-expr #'(f arg0 arg ...) (single-value #'map-expr) (list* (tc-expr #'f) res0 res) expected)])]
;; ormap/andmap of ... argument ;; ormap/andmap of ... argument
[(#%plain-app (~and fun (~or (~literal andmap) (~literal ormap))) f arg) [(#%plain-app (~and fun (~or (~literal andmap) (~literal ormap))) f arg)
;; check the arguments ;; check the arguments