From 29cd6cac2fda81aeb06a84212d0b30b8a700dffa Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 17 May 2010 16:20:44 -0500 Subject: [PATCH] Fix repeated type ascription. original commit: d2a1470ea51b5ca55656833f95dacd5ae7ba1285 --- .../typed-scheme/succeed/float-internal-err.rkt | 12 ++++++++++++ .../typed-scheme/private/type-annotation.rkt | 17 +++++++++++++++-- 2 files changed, 27 insertions(+), 2 deletions(-) create mode 100644 collects/tests/typed-scheme/succeed/float-internal-err.rkt diff --git a/collects/tests/typed-scheme/succeed/float-internal-err.rkt b/collects/tests/typed-scheme/succeed/float-internal-err.rkt new file mode 100644 index 00000000..a349d826 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/float-internal-err.rkt @@ -0,0 +1,12 @@ +#lang typed/scheme + +(require racket/flonum) + +(define-syntax FLOAT* (syntax-rules () ((FLOAT* x ...) (ann (* (ann x Float) ...) Float)))) +(define-syntax FLOATsin (syntax-rules () ((FLOATsin x) (ann (flsin (ann x Float)) Float)))) + +(: tfo-align Any) +(define (tfo-align) 0.0 + + (let* ((x (FLOAT* 0.0 (FLOATsin 0.)))) + 0)) \ No newline at end of file diff --git a/collects/typed-scheme/private/type-annotation.rkt b/collects/typed-scheme/private/type-annotation.rkt index fd0b897b..b459c837 100644 --- a/collects/typed-scheme/private/type-annotation.rkt +++ b/collects/typed-scheme/private/type-annotation.rkt @@ -63,11 +63,24 @@ (parse-tc-results prop) (parse-tc-results/id stx prop))) (cond - [(syntax-property stx type-ascrip-symbol) => pt] + [(syntax-property stx type-ascrip-symbol) + => + (lambda (prop) + (if (pair? prop) + (pt (car prop)) + (pt prop)))] [else #f])) (define (remove-ascription stx) - (syntax-property stx type-ascrip-symbol #f)) + (syntax-property stx type-ascrip-symbol + (cond + [(syntax-property stx type-ascrip-symbol) + => + (lambda (prop) + (if (pair? prop) + (cdr prop) + #f))] + [else #f]))) (define (log/ann stx ty) (printf/log "Required Annotated Variable: ~a ~a~n" (syntax-e stx) ty))