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

Clean up contracts in TR.

Browse Source 
original commit: 6fe850ce39e01ce7122f7325e020cf24133a9a45
This commit is contained in:
Eric Dobson 2012-09-01 16:26:27 -07:00 committed by Sam Tobin-Hochstadt
parent f1ce0b63dd
commit ecf4869b3e
4 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -307,7 +307,7 @@
;; acc-ids : names of the accessors
;; maker-id : name of the constructor
(def-type Struct ([name identifier?]
[parent (or/c #f Struct? Name?)]
[parent (or/c #f Struct?)]
[flds (listof fld?)]
[proc (or/c #f Function?)]
[poly? (or/c #f (listof symbol?))]

2
collects/typed-racket/typecheck/signatures.rkt
View File

@ -30,7 +30,7 @@
(define-signature tc-app^
([cond-contracted tc/app (syntax? . -> . tc-results?)]
[cond-contracted tc/app/check (syntax? tc-results? . -> . tc-results?)]
[cond-contracted tc/app-regular (syntax? . -> . tc-results?)]))
[cond-contracted tc/app-regular (syntax? (or/c tc-results? #f) . -> . tc-results?)]))
(define-signature tc-apply^
([cond-contracted tc/apply (syntax? syntax? . -> . tc-results?)]))

3
collects/typed-racket/typecheck/tc-app/signatures.rkt
View File

@ -1,11 +1,12 @@
#lang racket/base
(require racket/unit
"../../utils/utils.rkt" "../../utils/unit-utils.rkt"
syntax/parse/experimental/reflect
racket/contract
(types utils))
(provide (except-out (all-defined-out) checker/c))
(define checker/c (syntax? (or/c #f tc-results?). -> . (or/c #f tc-results?)))
(define checker/c reified-syntax-class?)
(define-signature tc-app-hetero^
([cond-contracted tc/app-hetero checker/c]))

7
collects/typed-racket/typecheck/tc-structs.rkt
View File

@ -277,7 +277,7 @@
;; create the actual structure type, and the types of the fields
;; that the outside world will see
(mk/register-sty nm flds parent-name (get-parent-flds parent) types
(mk/register-sty nm flds parent (get-parent-flds parent) types
;; procedure
#:proc-ty proc-ty-parsed
#:maker maker
@ -295,10 +295,11 @@
(c-> identifier? (or/c #f identifier?) (listof identifier?)
(listof Type/c) (or/c #f identifier?)
any/c)
(define parent-name (if parent (make-Name parent) #f))
(define parent-name (and parent (make-Name parent)))
(define parent-type (and parent (lookup-type-name parent)))
(define parent-flds (if parent (get-parent-flds parent-name) null))
(define parent-tys (map fld-t parent-flds))
(define defs (mk/register-sty nm flds parent-name parent-flds tys #:mutable #t))
(define defs (mk/register-sty nm flds parent-type parent-flds tys #:mutable #t))
(when kernel-maker
(register-type kernel-maker (λ () (->* (append parent-tys tys) (lookup-type-name nm))))))