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

base-env now compiles

Browse Source 
svn: r13954

original commit: e53a851bc21a1759161e0831730cc97c36743e2e
This commit is contained in:
Sam Tobin-Hochstadt 2009-03-04 19:28:48 +00:00
parent 5b48a2df26
commit 361712cb27
2 changed files with 32 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/typed-scheme/private/base-env.ss
View File

@ -106,7 +106,7 @@
[((a b c . -> . c) c (-lst a) (-lst b)) c]))]
[foldr (-poly (a b c) ((a b . -> . b) b (-lst a) . -> . b))]
[filter (-poly (a b) (cl->*
((make-pred-ty a B b)
((make-pred-ty (list a) B b)
(-lst a)
. -> .
(-lst b))
@ -132,8 +132,8 @@
(error
(make-Function (list
(make-arr (list Sym -String) (Un) Univ)
(make-arr (list -String) (Un) Univ)
(make-arr (list Sym -String) (Un) #:rest Univ)
(make-arr (list -String) (Un) #:rest Univ)
(make-arr (list Sym) (Un)))))
[namespace-variable-value
@ -243,9 +243,9 @@
[apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
[kernel:apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
[time-apply (-polydots (b a) (((list) (a a) . ->... . b)
(-lst a)
. -> .
[time-apply (-polydots (b a) (make-arr/values
(list ((list) (a a) . ->... . b)
(-lst a))
(-values (list (-pair b (-val '())) N N N))))]
[call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
@ -253,7 +253,8 @@
[quotient (-Integer -Integer . -> . -Integer)]
[remainder (-Integer -Integer . -> . -Integer)]
[quotient/remainder (-Integer -Integer . -> . (-values (list -Integer -Integer)))]
[quotient/remainder
(make-arr/values (list -Integer -Integer) (-values (list -Integer -Integer)))]
;; parameter stuff

28
collects/typed-scheme/types/abbrev.ss
View File

@ -17,7 +17,7 @@
;; convenient constructors
(define -values make-Values)
(define -pair make-Pair)
(define -val make-Value)
(define -Param make-Param)
@ -52,6 +52,10 @@
(c:->* (Type/c) (LFilterSet? LatentObject?) Result?)
(make-Result t f o))
(d/c (-values args)
(c:-> (listof Type/c) Values?)
(make-Values (for/list ([i args]) (-result i))))
;; basic types
(define make-promise-ty
@ -151,14 +155,30 @@
(d/c (make-arr* dom rng
#:rest [rest #f] #:drest [drest #f] #:kws [kws null]
#:filters [filters -no-lfilter] #:object [obj -no-lobj])
(c:->* ((listof Type/c) Type/c)
(c:->* ((listof Type/c) (or/c Values? ValuesDots? Type/c))
(#:rest Type/c
#:drest (cons/c Type/c symbol?)
#:kws (listof Keyword?)
#:filters LFilterSet?
#:object LatentObject?)
arr?)
(make-arr dom (-values (list (-result rng filters obj))) rest drest (sort #:key Keyword-kw kws keyword<?)))
(make-arr dom (if (or (Values? rng) (ValuesDots? rng))
rng
(make-Values (list (-result rng filters obj))))
rest drest (sort #:key Keyword-kw kws keyword<?)))
(d/c (make-arr/values dom rng
#:rest [rest #f] #:drest [drest #f] #:kws [kws null]
#:filters [filters -no-lfilter] #:object [obj -no-lobj])
(c:->* ((listof Type/c) (or/c ValuesDots? Values?))
(#:rest Type/c
#:drest (cons/c Type/c symbol?)
#:kws (listof Keyword?)
#:filters LFilterSet?
#:object LatentObject?)
arr?)
(make-arr dom rng rest drest (sort #:key Keyword-kw kws keyword<?)))
(define-syntax ->*
(syntax-rules (:)
@ -167,7 +187,7 @@
[(_ dom rst rng)
(make-Function (list (make-arr* dom rng #:rest rst)))]
[(_ dom rng : filters)
(make-Function (list (make-arr* dom rng #f #:filters filters)))]
(make-Function (list (make-arr* dom rng #:filters filters)))]
[(_ dom rst rng : filters)
(make-Function (list (make-arr* dom rng #:rest rst #:filters filters)))]))