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

Cleanup type-ascription.

Browse Source 
original commit: 32fc2b99b8929d799685ca1299255e4becba0458
This commit is contained in:
Eric Dobson 2013-05-27 12:56:47 -07:00
parent f23e278f31
commit 635979b6b2
2 changed files with 6 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt
View File

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

29
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt
View File

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