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

Cleanup builtin structs types.

Browse Source 
original commit: a408d6bfbfacae706b8d1d51f67c7929c3fcae16
This commit is contained in:
Eric Dobson 2012-07-15 10:25:11 -07:00 committed by Sam Tobin-Hochstadt
parent 0277c62e46
commit 8c95235750
2 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -23,6 +23,7 @@
(only-in string-constants/private/only-once maybe-print-message)
(only-in mzscheme make-namespace)
(only-in racket/match/runtime match:error matchable? match-equality-test))
"base-structs.rkt"
racket/file
(only-in racket/private/pre-base new-apply-proc)
(only-in (types abbrev) [-Boolean B] [-Symbol Sym])
@ -390,7 +391,6 @@
[list? (make-pred-ty (-lst Univ))]
[list (-poly (a) (->* '() a (-lst a)))]
[procedure? (make-pred-ty top-func)]
[map (-polydots (c a b)
(cl->*
(-> (-> a c) (-pair a (-lst a)) (-pair c (-lst c)))
@ -570,6 +570,16 @@
[assf (-poly (a b) ((a . -> . Univ) (-lst (-pair a b))
. -> . (-opt (-pair a b))))]
;Procedures Section 3.17
[procedure? (make-pred-ty top-func)]
[compose (-poly (a b c) (-> (-> b c) (-> a b) (-> a c)))]
[compose1 (-poly (a b c) (-> (-> b c) (-> a b) (-> a c)))]
[procedure-arity (-> top-func (Un -Nat -Arity-At-Least (-lst (Un -Nat -Arity-At-Least))))]
[procedure-arity? (make-pred-ty (Un -Nat -Arity-At-Least (-lst (Un -Nat -Arity-At-Least))))]
[procedure-arity-includes? (->opt top-func -Nat [Univ] B)]
[procedure-reduce-arity (-> top-func (Un -Nat -Arity-At-Least (-lst (Un -Nat -Arity-At-Least))) top-func)]
[procedure-keywords (-> top-func (-values (list (-lst -Keyword) (-opt (-lst -Keyword)))))]
[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))]
@ -701,8 +711,8 @@
[seconds->date (cl->* (-Integer . -> . (make-Name #'date))
(-Integer Univ . -> . (make-Name #'date)))]
[seconds->date (cl->* (-Integer . -> . -Date)
(-Integer Univ . -> . -Date))]
[current-seconds (-> -Integer)]
;Section 14.2
@ -1994,10 +2004,6 @@
;Section 13.9 (Code Inspectors)
[current-code-inspector (-Param -Inspector -Inspector)]
[compose (-poly (a b c) (-> (-> b c) (-> a b) (-> a c)))]
;ephemerons
[make-ephemeron (-poly (k v) (-> k v (make-Ephemeron v)))]
[ephemeron? (make-pred-ty (make-Ephemeron Univ))]

11
collects/typed-racket/base-env/base-structs.rkt
View File

@ -4,15 +4,15 @@
"../utils/utils.rkt"
(utils tc-utils)
(env init-envs)
(except-in (rep filter-rep object-rep type-rep) make-arr)
(rename-in (types abbrev numeric-tower union) [make-arr* make-arr])
(rep filter-rep object-rep type-rep)
(types abbrev numeric-tower union)
(typecheck tc-structs)
;;For tests
(prefix-in k: '#%kernel))
(require (for-template racket/base (prefix-in k: '#%kernel)))
(provide initialize-structs)
(provide initialize-structs -Date -Srcloc -Date -Arity-At-Least)
(define-syntax define-hierarchy
(syntax-rules (define-hierarchy)
@ -37,6 +37,11 @@
...)
...)]))
(define -Srcloc (make-Name #'srcloc))
(define -Date (make-Name #'date))
(define -Arity-At-Least (make-Name #'arity-at-least))
(define -Exn (make-Name #'exn))
(define (initialize-structs)