From 635979b6b28afea7807b3961138c8f5e92b3287b Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Mon, 27 May 2013 12:56:47 -0700 Subject: [PATCH] Cleanup type-ascription. original commit: 32fc2b99b8929d799685ca1299255e4becba0458 --- .../typed-racket/private/parse-type.rkt | 3 -- .../typed-racket/private/type-annotation.rkt | 29 ++++--------------- 2 files changed, 6 insertions(+), 26 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt index 1328c800..e5f73acd 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt @@ -34,7 +34,6 @@ ;; context of the given syntax object [parse-type/id (syntax? c:any/c . c:-> . Type/c)] [parse-tc-results (syntax? . c:-> . tc-results/c)] - [parse-tc-results/id (syntax? c:any/c . c:-> . tc-results/c)] [parse-literal-alls (syntax? . c:-> . (c:listof (c:or/c (c:listof identifier?) (c:list/c (c:listof identifier?) identifier?))))]) (provide star ddd/bound @@ -825,8 +824,6 @@ (stx-map (lambda (x) -no-obj) #'(t ...)))] [t (ret (parse-type #'t) -no-filter -no-obj)])) -(define parse-tc-results/id (parse/id parse-tc-results)) - (define parse-type/id (parse/id parse-type)) ;; parse-error : String String String ... ... -> Void diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt index 622f8449..76df1fcc 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt @@ -50,35 +50,18 @@ #:attr type (type-annotation #'i) #:when (attribute type)]) -;(trace type-annotation) - (define (type-ascription stx) - (define (pt prop) - (add-scoped-tvars stx (parse-literal-alls prop)) - (if (syntax? prop) - (parse-tc-results prop) - (parse-tc-results/id stx prop))) (syntax-parse stx [s:type-ascription^ - (let loop ((prop (attribute s.value))) - (if (pair? prop) - (loop (cdr prop)) - (pt prop)))] + (define prop (attribute s.value)) + (unless (syntax? prop) + (int-err "Type ascription is bad: ~a" prop)) + (add-scoped-tvars stx (parse-literal-alls prop)) + (parse-tc-results prop)] [_ #f])) (define (remove-ascription stx) - (type-ascription-property - stx - (syntax-parse stx - [s:type-ascription^ - (define prop (attribute s.value)) - (if (pair? prop) - (let loop ((prop (cdr prop)) (last (car prop))) - (if (pair? prop) - (cons last (loop (cdr prop) (car prop))) - last)) - #f)] - [_ #f]))) + (type-ascription-property stx #f)) ;; get the type annotation of this identifier, otherwise error ;; if #:default is provided, return that instead of error