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

Use tc-result1: instead of tc-result: in object handling.

Browse Source 
Use tc-results->values instead of bogus version.

svn: r14937

original commit: 0feb99f6bc08fdff518cf9587438ab4e46493166
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-22 21:19:46 +00:00
parent 7d38e20994
commit 39eca53d55
2 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,7 @@
(require (except-in "../utils/utils.ss" extend))
(require syntax/kerncase
scheme/match
"signatures.ss"
"signatures.ss" "tc-metafunctions.ss"
(types utils convenience union subtype)
(utils tc-utils)
(rep type-rep))
@ -61,8 +61,7 @@
[stx
;; this is a hander function
(syntax-property form 'typechecker:exn-handler)
(tc-expr/check form (match expected
[(tc-result1: e) (ret (-> (Un) e))]))]
(tc-expr/check form (ret (-> (Un) (tc-results->values expected))))]
[stx
;; this is the body of the with-handlers
(syntax-property form 'typechecker:exn-body)

8
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -355,17 +355,17 @@
(define (tc/send rcvr method args [expected #f])
(match (tc-expr rcvr)
[(tc-result: (Instance: (and c (Class: _ _ methods))))
[(tc-result1: (Instance: (and c (Class: _ _ methods))))
(match (tc-expr method)
[(tc-result: (Value: (? symbol? s)))
[(tc-result1: (Value: (? symbol? s)))
(let* ([ftype (cond [(assq s methods) => cadr]
[else (tc-error/expr "send: method ~a not understood by class ~a" s c)])]
[ret-ty (tc/funapp rcvr args (ret ftype) (map tc-expr (syntax->list args)) expected)])
(if expected
(begin (check-below ret-ty expected) (ret expected))
ret-ty))]
[(tc-result: t) (int-err "non-symbol methods not supported by Typed Scheme: ~a" t)])]
[(tc-result: t) (tc-error/expr #:return (or expected (ret (Un))) "send: expected a class instance, got ~a" t)]))
[(tc-result1: t) (int-err "non-symbol methods not supported by Typed Scheme: ~a" t)])]
[(tc-result1: t) (tc-error/expr #:return (or expected (ret (Un))) "send: expected a class instance, got ~a" t)]))
(define (single-value form [expected #f])
(define t (if expected (tc-expr/check form expected) (tc-expr form)))