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

Add a type for #%kernel's reverse.

Browse Source 
Present in the expansion of for/list.

original commit: 88a3d93e9e93118a57a25c5da0b392763552a3bd
This commit is contained in:
Vincent St-Amour 2011-07-29 12:53:42 -04:00
parent c3a9c07979
commit fcfa476f15
2 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/typed-scheme/base-env/base-env.rkt
View File

@ -12,7 +12,7 @@
(only-in rnrs/lists-6 fold-left)
'#%paramz
"extra-procs.rkt"
(only-in '#%kernel [apply kernel:apply])
(only-in '#%kernel [apply kernel:apply] [reverse kernel:reverse])
(only-in racket/private/pre-base new-apply-proc)
scheme/promise scheme/system
racket/function
@ -489,6 +489,7 @@
[touch (-poly (A) ((-future A) . -> . A))]
[reverse (-poly (a) (-> (-lst a) (-lst a)))]
[kernel:reverse (-poly (a) (-> (-lst a) (-lst a)))]
[append (-poly (a) (->* (list) (-lst a) (-lst a)))]
[length (-poly (a) (-> (-lst a) -Index))]
[memq (-poly (a) (-> a (-lst a) (-opt (-lst a))))]

10
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -5,12 +5,12 @@
"tc-app-helper.rkt" "find-annotation.rkt" "tc-funapp.rkt"
"tc-subst.rkt" (prefix-in c: racket/contract)
syntax/parse racket/match racket/trace scheme/list
unstable/sequence unstable/list
unstable/sequence unstable/list
;; fixme - don't need to be bound in this phase - only to make tests work
scheme/bool
racket/unsafe/ops
(only-in racket/private/class-internal make-object do-make-object)
(only-in '#%kernel [apply k:apply])
(only-in '#%kernel [apply k:apply] [reverse k:reverse])
;; end fixme
(for-syntax syntax/parse scheme/base (utils tc-utils))
(private type-annotation)
@ -23,7 +23,7 @@
'#%paramz
(for-template
racket/unsafe/ops racket/fixnum racket/flonum
(only-in '#%kernel [apply k:apply])
(only-in '#%kernel [apply k:apply] [reverse k:reverse])
"internal-forms.rkt" scheme/base scheme/bool '#%paramz
(only-in racket/private/class-internal make-object do-make-object)))
@ -262,7 +262,7 @@
(syntax-parse form
#:literals (#%plain-app #%plain-lambda letrec-values quote
values apply k:apply not false? list list* call-with-values do-make-object make-object cons
map andmap ormap reverse extend-parameterization
map andmap ormap reverse k:reverse extend-parameterization
vector-ref unsafe-vector-ref unsafe-vector*-ref
vector-set! unsafe-vector-set! unsafe-vector*-set!
unsafe-struct-ref unsafe-struct*-ref unsafe-struct-set! unsafe-struct*-set!)
@ -668,7 +668,7 @@
[tys (reverse tys-r)])
(ret (foldr make-Pair last tys)))]
;; special case for `reverse' to propagate expected type info
[(#%plain-app reverse arg)
[(#%plain-app (~or reverse k:reverse) arg)
(match expected
[(tc-result1: (Listof: _))
(tc-expr/check #'arg expected)]