From 49eb5a40a04e07a9c53806a25ee20ab6a5fa1307 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 24 May 2013 20:54:05 -0400 Subject: [PATCH] Attempt to support recursive types in classes better original commit: a1efc2c276e7a37d3ae9faff6414e5a54e9bdcbf --- .../typecheck/check-class-unit.rkt | 2 ++ .../typed-racket/typecheck/tc-send.rkt | 26 +++++++++++-------- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt index 60c64422..83a749f7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt @@ -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)])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-send.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-send.rkt index d35735e0..744cf555 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-send.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-send.rkt @@ -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)))