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

Attempt to support recursive types in classes better

Browse Source 
original commit: a1efc2c276e7a37d3ae9faff6414e5a54e9bdcbf
This commit is contained in:
Asumu Takikawa 2013-05-24 20:54:05 -04:00
parent dbfba09d05
commit 49eb5a40a0
2 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
View File

@ -149,6 +149,8 @@
;; class produced by class: due to the syntax property
(define (check-class form [expected #f])
(match expected
[(tc-result1: (? Mu? type))
(check-class form (ret (unfold type)))]
[(tc-result1: (and self-class-type (Class: _ _ _ _)))
(do-check form #t self-class-type)]
[#f (do-check form #f #f)]))

26
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-send.rkt
View File

@ -12,15 +12,19 @@
(export tc-send^)
(define (tc/send form rcvr method args [expected #f])
(match (tc-expr rcvr)
[(tc-result1: (Instance: (and c (Class: _ _ _ methods))))
(match (tc-expr method)
[(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)])]
[retval (tc/funapp rcvr args (ret ftype) (stx-map tc-expr args) expected)])
(add-typeof-expr form retval)
retval)]
[(tc-result1: t) (int-err "non-symbol methods not supported by Typed Racket: ~a" t)])]
[(tc-result1: t) (tc-error/expr #:return (or expected (ret -Bottom)) "send: expected a class instance, got ~a" t)]))
(define (do-check rcvr-type)
(match rcvr-type
[(tc-result1: (Instance: (? Mu? type)))
(do-check (ret (make-Instance (unfold type))))]
[(tc-result1: (Instance: (and c (Class: _ _ _ methods))))
(match (tc-expr method)
[(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)])]
[retval (tc/funapp rcvr args (ret ftype) (stx-map tc-expr args) expected)])
(add-typeof-expr form retval)
retval)]
[(tc-result1: t) (int-err "non-symbol methods not supported by Typed Racket: ~a" t)])]
[(tc-result1: t) (tc-error/expr #:return (or expected (ret -Bottom)) "send: expected a class instance, got ~a" t)]))
(do-check (tc-expr rcvr)))