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

Add typeof mappings only to original form.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-07-06 11:10:05 -04:00
parent 692a172474
commit e865380f6f
1 changed files with 9 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/typed-scheme/typecheck/tc-expr-unit.rkt
View File

@ -176,23 +176,24 @@
(unless (syntax? form) (unless (syntax? form)
(int-err "bad form input to tc-expr: ~a" form)) (int-err "bad form input to tc-expr: ~a" form))
;; typecheck form ;; typecheck form
(let loop ([form form] [expected expected] [checked? #f]) (let loop ([form* form] [expected expected] [checked? #f])
(cond [(type-ascription form) (cond [(type-ascription form*)
=> =>
(lambda (ann) (lambda (ann)
(let* ([r (tc-expr/check/internal form ann)] (let* ([r (tc-expr/check/internal form* ann)]
[r* (check-below r expected)]) [r* (check-below r expected)])
;; add this to the *original* form, since the newer forms aren't really in the program
(add-typeof-expr form expected) (add-typeof-expr form expected)
;; around again in case there is an instantiation ;; around again in case there is an instantiation
;; remove the ascription so we don't loop infinitely ;; remove the ascription so we don't loop infinitely
(loop (remove-ascription form) r* #t)))] (loop (remove-ascription form*) r* #t)))]
[(syntax-property form 'type-inst) [(syntax-property form* 'type-inst)
;; check without property first ;; check without property first
;; to get the appropriate type to instantiate ;; to get the appropriate type to instantiate
(match (tc-expr (syntax-property form 'type-inst #f)) (match (tc-expr (syntax-property form* 'type-inst #f))
[(tc-results: ts fs os) [(tc-results: ts fs os)
;; do the instantiation on the old type ;; do the instantiation on the old type
(let* ([ts* (do-inst form ts)] (let* ([ts* (do-inst form* ts)]
[ts** (ret ts* fs os)]) [ts** (ret ts* fs os)])
(add-typeof-expr form ts**) (add-typeof-expr form ts**)
;; make sure the new type is ok ;; make sure the new type is ok
@ -201,27 +202,10 @@
[ty (add-typeof-expr form ty) ty])] [ty (add-typeof-expr form ty) ty])]
;; nothing to see here ;; nothing to see here
[checked? expected] [checked? expected]
[else (let ([t (tc-expr/check/internal form expected)]) [else (let ([t (tc-expr/check/internal form* expected)])
(add-typeof-expr form t) (add-typeof-expr form t)
t)])))) t)]))))
#;
(define (tc-or e1 e2 or-part [expected #f])
(match (single-value e1)
[(tc-result1: t1 (and f1 (FilterSet: fs+ fs-)) o1)
(let*-values ([(flag+ flag-) (values (box #t) (box #t))])
(match-let* ([(tc-result1: t2 f2 o2) (with-lexical-env
(env+ (lexical-env) fs+ flag+)
(with-lexical-env/extend
(list or-part) (list (restrict t1 (-val #f))) (single-value e2 expected)))]
[t1* (remove t1 (-val #f))]
[f1* (-FS null (list (make-Bot)))])
;; if we have the same number of values in both cases
(let ([r (combine-filter f1 f1* f2 t1* t2 o1 o2)])
(if expected
(check-below r expected)
r))))]))
;; tc-expr/check : syntax tc-results -> tc-results ;; tc-expr/check : syntax tc-results -> tc-results
(define (tc-expr/check/internal form expected) (define (tc-expr/check/internal form expected)
(parameterize ([current-orig-stx form]) (parameterize ([current-orig-stx form])