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

Fixed parsing of keyword types.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-08-04 13:17:15 -04:00
parent b1e744b1e1
commit 416591b355
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/typed-scheme/private/parse-type.rkt
View File

@ -88,6 +88,13 @@
(pattern (~seq [k:keyword t:expr]) (pattern (~seq [k:keyword t:expr])
#:attr Keyword (make-Keyword (syntax-e #'k) (parse-type #'t) #f))) #:attr Keyword (make-Keyword (syntax-e #'k) (parse-type #'t) #f)))
(define-syntax-class non-keyword-ty
(pattern (k e:expr ...)
#:when (not (keyword? (syntax->datum #'k))))
(pattern t:expr
#:when (and (not (keyword? (syntax->datum #'t)))
(not (syntax->list #'t)))))
(define-syntax-class path-elem (define-syntax-class path-elem
#:description "path element" #:description "path element"
#:literals (car cdr) #:literals (car cdr)
@ -214,7 +221,7 @@
(add-type-name-reference #'kw) (add-type-name-reference #'kw)
;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
(make-pred-ty (list (parse-type #'dom)) (parse-type #'rng) (attribute latent.type) 0 (attribute latent.path))] (make-pred-ty (list (parse-type #'dom)) (parse-type #'rng) (attribute latent.type) 0 (attribute latent.path))]
[(dom:expr ... rest:expr ddd:star kws:keyword-tys ... (~and kw t:->) rng) [(dom:non-keyword-ty ... rest:non-keyword-ty ddd:star kws:keyword-tys ... (~and kw t:->) rng)
(add-type-name-reference #'kw) (add-type-name-reference #'kw)
(make-Function (make-Function
(list (make-arr (list (make-arr
@ -222,7 +229,7 @@
(parse-values-type #'rng) (parse-values-type #'rng)
#:rest (parse-type #'rest) #:rest (parse-type #'rest)
#:kws (attribute kws.Keyword))))] #:kws (attribute kws.Keyword))))]
[(dom:expr ... rest:expr :ddd/bound (~and kw t:->) rng) [(dom:non-keyword-ty ... rest:non-keyword-ty :ddd/bound (~and kw t:->) rng)
(add-type-name-reference #'kw) (add-type-name-reference #'kw)
(let* ([bnd (syntax-e #'bound)]) (let* ([bnd (syntax-e #'bound)])
(unless (bound-index? bnd) (unless (bound-index? bnd)
@ -236,7 +243,7 @@
(extend-tvars (list bnd) (extend-tvars (list bnd)
(parse-type #'rest)) (parse-type #'rest))
bnd))))] bnd))))]
[(dom:expr ... rest:expr _:ddd (~and kw t:->) rng) [(dom:non-keyword-ty ... rest:non-keyword-ty _:ddd (~and kw t:->) rng)
(add-type-name-reference #'kw) (add-type-name-reference #'kw)
(let ([var (infer-index stx)]) (let ([var (infer-index stx)])
(make-Function (make-Function
@ -251,7 +258,7 @@
(->* (map parse-type (syntax->list #'(dom ...))) (->* (map parse-type (syntax->list #'(dom ...)))
(parse-values-type #'rng))] |# (parse-values-type #'rng))] |#
;; use expr to rule out keywords ;; use expr to rule out keywords
[(dom:expr ... kws:keyword-tys ... (~and kw t:->) rng) [(dom:non-keyword-ty ... kws:keyword-tys ... (~and kw t:->) rng)
(add-type-name-reference #'kw) (add-type-name-reference #'kw)
(let ([doms (for/list ([d (syntax->list #'(dom ...))]) (let ([doms (for/list ([d (syntax->list #'(dom ...))])
(parse-type d))]) (parse-type d))])