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

Instances can have any Type as their class.

Browse Source 
Fix some handling of tc-results as pertains to classes.
Bottom is an ok Class.

svn: r14938

original commit: 7d239a4dfaa5d44e2bdbb8ebc31b72bbd3f87b61
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-22 21:41:12 +00:00
parent 39eca53d55
commit 136f8c4f80
4 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -298,7 +298,7 @@
(map list mname (map type-rec-id mty)))])])
;; cls : Class
(dt Instance ([cls Class?]) [#:key 'instance])
(dt Instance ([cls Type/c]) [#:key 'instance])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -101,6 +101,7 @@
(let loop ([t (tc-expr cl)])
(match t
[(tc-result1: (? Mu? t*)) (loop (ret (unfold t*)))]
[(tc-result1: (Union: '())) (ret (Un))]
[(tc-result1: (and c (Class: pos-tys (list (and tnflds (list tnames _ _)) ...) _)))
(unless (= (length pos-tys)
(length (syntax->list pos-args)))
@ -109,7 +110,7 @@
;; use for, since they might be different lengths in error case
(for ([pa (in-syntax pos-args)]
[pt (in-list pos-tys)])
(tc-expr/check pa pt))
(tc-expr/check pa (ret pt)))
(for ([n names]
#:when (not (memq n tnames)))
(tc-error/delayed
@ -124,7 +125,7 @@
[else #f])])
(if s
;; this argument was present
(tc-expr/check s tfty)
(tc-expr/check s (ret tfty))
;; this argument wasn't provided, and was optional
#f))])
tnflds)

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

@ -362,7 +362,7 @@
[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))
(begin (check-below ret-ty expected) expected)
ret-ty))]
[(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)]))

2
collects/typed-scheme/typecheck/tc-let-unit.ss
View File

@ -84,7 +84,7 @@
(loop (cdr names) (cdr exprs) (apply append (cdr names)) (cdr clauses)))]
[else
;(for-each (lambda (vs) (for-each (lambda (v) (printf/log "Letrec Var: ~a~n" (syntax-e v))) vs)) names)
(do-check (lambda (stx e t) (tc-expr/check/t e t))
(do-check (lambda (stx e t) (tc-expr/check e t))
names (map (lambda (l) (map get-type l)) names) form exprs body clauses expected)]))))
;; this is so match can provide us with a syntax property to