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

Make AnyValues but don't actually start using it yet.

Browse Source
This commit is contained in:
Eric Dobson 2013-01-17 23:52:37 -08:00 committed by Sam Tobin-Hochstadt
parent 4b279eaf6a
commit aac25b42c9
10 changed files with 32 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
View File

@ -97,7 +97,7 @@
(tc-e (make-handle-get-preference-locked .3 'sym (lambda () 'eseh) 'timestamp #f #:lock-there #f #:max-delay .45)
(t:-> -Pathlike ManyUniv))
(t:-> -Pathlike Univ))
(tc-e (call-with-file-lock/timeout #f 'exclusive (lambda () 'res) (lambda () 'err)
#:lock-file "lock"

2
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -1388,6 +1388,8 @@
;Wills
(tc-e (make-will-executor) -Will-Executor)
;; FIXME: Broken because ManyUniv doesn't have a corresponding tc-result
#;
(tc-e (let: ((w : Will-Executor (make-will-executor)))
(will-register w 'a (lambda: ((s : Symbol)) (void)))
(will-execute w)) ManyUniv)

2
collects/typed-racket/base-env/base-env.rkt
View File

@ -1970,7 +1970,7 @@
[make-security-guard
(->opt -Security-Guard
(-> Sym (-opt -Path) (-lst Sym) ManyUniv)
(-> Sym (-opt -String) (-opt -PosInt) (Un (one-of/c 'server 'client) ManyUniv))
(-> Sym (-opt -String) (-opt -PosInt) (one-of/c 'server 'client) ManyUniv)
[(-opt (-> Sym -Path -Path ManyUniv))]
-Security-Guard)]
[current-security-guard (-Param -Security-Guard -Security-Guard)]

16
collects/typed-racket/rep/type-rep.rkt
View File

@ -23,19 +23,24 @@
(not (fld? e))
(not (Values? e))
(not (ValuesDots? e))
(not (AnyValues? e))
(not (Result? e)))))
;; (or/c Type/c Values? Results?)
;; Anything that can be treated as a Values by sufficient expansion
(define Values/c?
(λ (e)
(and (Type? e)
(not (Scope? e))
(not (arr? e))
(not (fld? e))
(not (ValuesDots? e)))))
(not (ValuesDots? e))
(not (AnyValues? e)))))
(define Type/c (flat-named-contract 'Type Type/c?))
(define Values/c (flat-named-contract 'Values Values/c?))
(define SomeValues/c (or/c Values? AnyValues? ValuesDots?))
;; Name = Symbol
@ -222,6 +227,10 @@
[#:frees (λ (f) (combine-frees (map f rs)))]
[#:fold-rhs (*Values (map type-rec-id rs))])
(def-type AnyValues ()
[#:fold-rhs #:base])
(def-type ValuesDots ([rs (listof Result?)] [dty Type/c] [dbound (or/c symbol? natural-number/c)])
[#:frees (if (symbol? dbound)
(free-vars-remove (combine-frees (map free-vars* (cons dty rs))) dbound)
@ -234,7 +243,7 @@
;; arr is NOT a Type
(def-type arr ([dom (listof Type/c)]
[rng (or/c Values? ValuesDots?)]
[rng SomeValues/c]
[rest (or/c #f Type/c)]
[drest (or/c #f (cons/c Type/c (or/c natural-number/c symbol?)))]
[kws (listof Keyword?)])
@ -770,14 +779,13 @@
Mu? Poly? PolyDots?
Filter? Object?
Type/c Type/c?
Values/c
Values/c SomeValues/c
Poly-n
PolyDots-n
free-vars*
type-compare type<?
remove-dups
sub-f sub-o sub-pe
Values: Values? Values-rs
(rename-out [Mu:* Mu:]
[Poly:* Poly:]
[PolyDots:* PolyDots:]

2
collects/typed-racket/typecheck/tc-app-helper.rkt
View File

@ -83,7 +83,7 @@
#:msg-thunk [msg-thunk (lambda (dom) dom)])
((syntax? syntax? Type/c (c:listof (c:listof Type/c)) (c:listof (c:or/c #f Type/c))
(c:listof (c:or/c #f (c:cons/c Type/c (c:or/c c:natural-number/c symbol?))))
(c:listof (c:or/c Values? ValuesDots?)) (c:listof tc-results?) (c:or/c #f Type/c) c:any/c)
(c:listof SomeValues/c) (c:listof tc-results?) (c:or/c #f Type/c) c:any/c)
(#:expected (c:or/c #f tc-results?) #:return tc-results?
#:msg-thunk (c:-> string? string?))
. c:->* . tc-results?)

5
collects/typed-racket/typecheck/tc-app/tc-app-apply.rkt
View File

@ -5,7 +5,7 @@
"utils.rkt"
syntax/parse racket/match
syntax/parse/experimental/reflect
(typecheck signatures tc-funapp check-below tc-subst)
(typecheck signatures tc-funapp check-below)
(types abbrev utils)
(rep type-rep)
@ -24,7 +24,8 @@
#:literals (k:apply apply values)
(pattern ((~or apply k:apply) values e)
(match (single-value #'e)
[(tc-result1: (ListDots: dty dbound)) (values->tc-results (make-ValuesDots null dty dbound) #f)]
[(tc-result1: (ListDots: dty dbound))
(ret null null null dty dbound)]
[(tc-result1: (List: ts)) (ret ts)]
[_ (tc/apply #'values #'(e))]))
(pattern ((~or apply k:apply) f . args)

2
collects/typed-racket/typecheck/tc-metafunctions.rkt
View File

@ -13,7 +13,7 @@
(define/cond-contract (abstract-results results arg-names)
(tc-results? (listof identifier?) . -> . (or/c Values? ValuesDots?))
(tc-results? (listof identifier?) . -> . SomeValues/c)
(define keys (for/list ([(nm k) (in-indexed arg-names)]) k))
(match results
[(tc-results: ts fs os dty dbound)

8
collects/typed-racket/types/abbrev.rkt
View File

@ -329,16 +329,16 @@
(define/cond-contract (make-arr* dom rng
#:rest [rest #f] #:drest [drest #f] #:kws [kws null]
#:filters [filters -no-filter] #:object [obj -no-obj])
(c:->* ((listof Type/c) (or/c Values? ValuesDots? Type/c))
(c:->* ((listof Type/c) (or/c SomeValues/c Type/c))
(#:rest (or/c #f Type/c)
#:drest (or/c #f (cons/c Type/c symbol?))
#:kws (listof Keyword?)
#:filters FilterSet?
#:object Object?)
arr?)
(make-arr dom (if (or (Values? rng) (ValuesDots? rng))
rng
(make-Values (list (-result rng filters obj))))
(make-arr dom (if (Type/c? rng)
(make-Values (list (-result rng filters obj)))
rng)
rest drest (sort #:key Keyword-kw kws keyword<?)))
(define-syntax (->* stx)

5
collects/typed-racket/types/printer.rkt
View File

@ -165,6 +165,8 @@
(fp "~a ...~a~a "
(car drest) (if (special-dots-printing?) "" " ") (cdr drest)))
(match rng
[(AnyValues:)
(fp "-> AnyValues")]
[(Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:))))
(fp "-> ~a" t)]
[(Values: (list (Result: t
@ -272,7 +274,8 @@
[(ListDots: dty dbound)
(fp "(List ~a ...~a~a)" dty (if (special-dots-printing?) "" " ") dbound)]
[(F: nm) (fp "~a" nm)]
;; FIXME
;; FIXME (Values are not types and shouldn't need to be considered here
[(AnyValues:) (fp "AnyValues")]
[(Values: (list v)) (fp "~a" v)]
[(Values: (list v ...)) (fp "~s" (cons 'values v))]
[(ValuesDots: v dty dbound)

5
collects/typed-racket/types/subtype.rkt
View File

@ -48,7 +48,7 @@
;; is s a subtype of t?
;; type type -> boolean
(define/cond-contract (subtype s t)
(c:-> (c:or/c Type/c Values?) (c:or/c Type/c Values?) boolean?)
(c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)
(define k (cons (unsafe-struct-ref s 0) (unsafe-struct-ref t 0)))
(define (new-val)
(define result (handle-failure (and (subtype* (current-seen) s t) #t)))
@ -431,6 +431,7 @@
(subtype* A0 parent other)]
;; subtyping on values is pointwise
[((Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
[((or (Values: _) (AnyValues:)) (AnyValues:)) A0]
;; trivial case for Result
[((Result: t f o) (Result: t* f o))
(subtype* A0 t t*)]
@ -458,7 +459,7 @@
(provide/cond-contract
[subtype (c:-> (c:or/c Type/c Values?) (c:or/c Type/c Values?) boolean?)])
[subtype (c:-> (c:or/c Type/c SomeValues/c) (c:or/c Type/c SomeValues/c) boolean?)])
(provide
type-compare? subtypes/varargs subtypes)