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