Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Clean up contracts in TR.

  • Loading branch information...
commit 78b445fbead40b16a23241c2dfa5124186be0a6b 1 parent 83921f1
@shekari authored
View
2  collects/typed-racket/rep/type-rep.rkt
@@ -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?))]
View
2  collects/typed-racket/typecheck/signatures.rkt
@@ -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?)]))
View
3  collects/typed-racket/typecheck/tc-app/signatures.rkt
@@ -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]))
View
7 collects/typed-racket/typecheck/tc-structs.rkt
@@ -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))))))
Please sign in to comment.
Something went wrong with that request. Please try again.