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

Extend time-apply to work with procedures with more than 2 arguments.

Browse Source 
original commit: 24b6ecf2a6ea0cd444a38519c210bad669804b0f
This commit is contained in:
Vincent St-Amour 2012-06-17 22:02:36 -04:00
parent fe7589c807
commit 1477b41df6
2 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -822,7 +822,15 @@
[tc-e
(call-with-values (lambda () (time-apply + (list 1 2)))
(call-with-values (lambda () ((inst time-apply Number Number Number) + (list 1 2)))
(lambda: ([v : (Listof Number)]
[cpu : Number]
[user : Number]
[gc : Number])
'whatever))
#:ret (ret (-val 'whatever) -true-filter)]
[tc-e
(call-with-values (lambda () ((inst time-apply Number Number Number Number Number Number Number) + (list 1 2 3 4 5 6)))
(lambda: ([v : (Listof Number)]
[cpu : Number]
[user : Number]

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

@ -25,12 +25,14 @@
racket/file
(only-in racket/private/pre-base new-apply-proc)
(only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym])
(only-in (rep type-rep) make-MPairTop
(only-in (rep type-rep)
make-MPairTop
make-BoxTop make-ChannelTop make-VectorTop
make-ThreadCellTop
make-Ephemeron
make-CustodianBox
make-HeterogenousVector))
make-HeterogenousVector
make-ListDots))
;Section 9.2
@ -564,20 +566,12 @@
[apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
[new-apply-proc (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
[kernel:apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
[time-apply (-poly (a b c)
(cl->*
(->
(-> a)
(-Tuple (list))
(-values (list (-pair a (-val '())) -Nat -Nat -Nat)))
(->
(-> b a)
(-Tuple (list b))
(-values (list (-pair a (-val '())) -Nat -Nat -Nat)))
(->
(-> b c a)
(-Tuple (list b c))
(-values (list (-pair a (-val '())) -Nat -Nat -Nat)))))]
[time-apply
(-polydots (b a) (cl->*
(-> (-> b) (-val '()) (-values (list (-pair b (-val '())) -Nat -Nat -Nat)))
(-> (->... '() (a a) b)
(make-ListDots a 'a)
(-values (list (-pair b (-val '())) -Nat -Nat -Nat)))))]
[call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
[call/ec (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]