Attempt to support recursive types in classes better

This commit is contained in:
Asumu Takikawa 2013-05-24 20:54:05 -04:00
parent 16ca57500b
commit a1efc2c276
2 changed files with 17 additions and 11 deletions

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)]))

View File

@ -12,7 +12,10 @@
(export tc-send^)
(define (tc/send form rcvr method args [expected #f])
(match (tc-expr rcvr)
(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)))
@ -23,4 +26,5 @@
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)))