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

Allow prefix function arrow type

Browse Source 
Also fix a regression that made arrow type
parsing more permissive than desired due to
missing colon^s
This commit is contained in:
Asumu Takikawa 2014-01-07 16:02:10 -05:00
parent c64142ce24
commit 7dc5143f14
2 changed files with 35 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -313,24 +313,29 @@
(list (make-arr
doms
(parse-type (syntax/loc stx (rest-dom ...)))))))]
[(dom :->^ rng : latent:simple-latent-filter)
[(~or (:->^ dom rng :colon^ latent:simple-latent-filter)
(dom :->^ rng :colon^ latent:simple-latent-filter))
;; 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))]
[(dom ... :->^ rng
: ~! (~var latent (full-latent (syntax->list #'(dom ...)))))
[(~or (:->^ dom ... rng
:colon^ ~! (~var latent (full-latent (syntax->list #'(dom ...)))))
(dom ... :->^ rng
:colon^ ~! (~var latent (full-latent (syntax->list #'(dom ...))))))
;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
(->* (parse-types #'(dom ...))
(parse-type #'rng)
: (-FS (attribute latent.positive) (attribute latent.negative))
: (attribute latent.object))]
[(dom:non-keyword-ty ... kws:keyword-tys ... rest:non-keyword-ty ddd:star :->^ rng)
[(~or (:->^ dom:non-keyword-ty ... kws:keyword-tys ... rest:non-keyword-ty ddd:star rng)
(dom:non-keyword-ty ... kws:keyword-tys ... rest:non-keyword-ty ddd:star :->^ rng))
(make-Function
(list (make-arr
(parse-types #'(dom ...))
(parse-values-type #'rng)
#:rest (parse-type #'rest)
#:kws (attribute kws.Keyword))))]
[(dom:non-keyword-ty ... rest:non-keyword-ty :ddd/bound :->^ rng)
[(~or (:->^ dom:non-keyword-ty ... rest:non-keyword-ty :ddd/bound rng)
(dom:non-keyword-ty ... rest:non-keyword-ty :ddd/bound :->^ rng))
(let* ([bnd (syntax-e #'bound)])
(unless (bound-index? bnd)
(tc-error/stx #'bound
@ -343,7 +348,8 @@
(extend-tvars (list bnd)
(parse-type #'rest))
bnd))))]
[(dom:non-keyword-ty ... rest:non-keyword-ty _:ddd :->^ rng)
[(~or (:->^ dom:non-keyword-ty ... rest:non-keyword-ty _:ddd rng)
(dom:non-keyword-ty ... rest:non-keyword-ty _:ddd :->^ rng))
(let ([var (infer-index stx)])
(make-Function
(list
@ -356,7 +362,8 @@
(->* (parse-types #'(dom ...))
(parse-values-type #'rng))] |#
;; use expr to rule out keywords
[(dom:non-keyword-ty ... kws:keyword-tys ... :->^ rng)
[(~or (:->^ dom:non-keyword-ty ... kws:keyword-tys ... rng)
(dom:non-keyword-ty ... kws:keyword-tys ... :->^ rng))
(let ([doms (for/list ([d (in-syntax #'(dom ...))])
(parse-type d))])
(make-Function

21
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
View File

@ -82,30 +82,42 @@
[(-> (values Number Boolean Number)) (t:-> (-values (list N B N)))]
[(Number -> Number) (t:-> N N)]
[(All (A) Number -> Number) (-poly (a) (t:-> N N))]
[(All (A) -> Number Number) (-poly (a) (t:-> N N))]
[(All (A) (Number -> Number)) (-poly (a) (t:-> N N))]
[(All (A) (-> Number Number)) (-poly (a) (t:-> N N))]
[(All (A) A -> A) (-poly (a) (t:-> a a))]
[(All (A) A → A) (-poly (a) (t:-> a a))]
[(All (A) → A A) (-poly (a) (t:-> a a))]
[(All (A) (A -> A)) (-poly (a) (t:-> a a))]
[(All (A) (-> A A)) (-poly (a) (t:-> a a))]
;; requires transformer time stuff that doesn't work
#;[(Refinement even?) (make-Refinement #'even?)]
[(Number Number Number Boolean -> Number) (N N N B . t:-> . N)]
[(-> Number Number Number Boolean Number) (N N N B . t:-> . N)]
[(Number Number Number * -> Boolean) ((list N N) N . t:->* . B)]
[(-> Number Number Number * Boolean) ((list N N) N . t:->* . B)]
;[((. Number) -> Number) (->* (list) N N)] ;; not legal syntax
[(U Number Boolean) (t:Un N B)]
[(U Number Boolean Number) (t:Un N B)]
[(U Number Boolean 1) (t:Un N B)]
[(All (a) (Listof a)) (-poly (a) (make-Listof a))]
[(All (a ...) (a ... a -> Integer)) (-polydots (a) ( (list) (a a) . ->... . -Integer))]
[(All (a ...) (-> a ... a Integer)) (-polydots (a) ( (list) (a a) . ->... . -Integer))]
[(∀ (a) (Listof a)) (-poly (a) (make-Listof a))]
[(∀ (a ...) (a ... a -> Integer)) (-polydots (a) ( (list) (a a) . ->... . -Integer))]
[(∀ (a ...) (-> a ... a Integer)) (-polydots (a) ( (list) (a a) . ->... . -Integer))]
[(All (a ...) (a ... -> Number))
(-polydots (a) ((list) [a a] . ->... . N))]
[(All (a ...) (-> a ... Number))
(-polydots (a) ((list) [a a] . ->... . N))]
[(All (a ...) (-> (values a ...)))
(-polydots (a) (t:-> (make-ValuesDots (list) a 'a)))]
[(case-lambda (Number -> Boolean) (Number Number -> Number)) (cl-> [(N) B]
[(N N) N])]
[(case-> (Number -> Boolean) (Number Number -> Number)) (cl-> [(N) B]
[(N N) N])]
[(case-> (Number -> Boolean) (-> Number Number Number)) (cl-> [(N) B]
[(N N) N])]
[1 (-val 1)]
[#t (-val #t)]
[#f (-val #f)]
@ -117,14 +129,23 @@
[a (-v a) (dict-set initial-tvar-env 'a (-v a))]
[(Any -> Boolean : Number) (make-pred-ty -Number)]
[(-> Any Boolean : Number) (make-pred-ty -Number)]
[(Any -> Boolean : #:+ (Number @ 0) #:- (! Number @ 0))
(make-pred-ty -Number)]
[(-> Any Boolean : #:+ (Number @ 0) #:- (! Number @ 0))
(make-pred-ty -Number)]
[(Any -> Boolean : #:+ (! Number @ 0) #:- (Number @ 0))
(t:->* (list Univ) -Boolean : (-FS (-not-filter -Number 0 null) (-filter -Number 0 null)))]
[(-> Any Boolean : #:+ (! Number @ 0) #:- (Number @ 0))
(t:->* (list Univ) -Boolean : (-FS (-not-filter -Number 0 null) (-filter -Number 0 null)))]
[(Number -> Number -> Number)
(t:-> -Number (t:-> -Number -Number))]
[(-> Number (-> Number Number))
(t:-> -Number (t:-> -Number -Number))]
[(Integer -> (All (X) (X -> X)))
(t:-> -Integer (-poly (x) (t:-> x x)))]
[(-> Integer (All (X) (-> X X)))
(t:-> -Integer (-poly (x) (t:-> x x)))]
[(Opaque foo?) (make-Opaque #'foo?)]
;; PR 14122