From 37236ea16e629e4c930cbc6ffc6e3f70c8dbebec Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Wed, 2 Jan 2013 14:58:27 -0800 Subject: [PATCH] Fix register-struct-bindings! to meet correct contract. Please merge to 5.3.2. (cherry picked from commit a5daacd74701603eede1bd31346520c8afce4e09) --- .../typed-racket/typecheck/tc-structs.rkt | 22 ++++++++++++------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/collects/typed-racket/typecheck/tc-structs.rkt b/collects/typed-racket/typecheck/tc-structs.rkt index 0f54e17e8c..2920f08649 100644 --- a/collects/typed-racket/typecheck/tc-structs.rkt +++ b/collects/typed-racket/typecheck/tc-structs.rkt @@ -150,7 +150,7 @@ ;; Register the approriate types to the struct bindings. (define/cond-contract (register-struct-bindings! sty names desc si) - (c-> Struct? struct-names? struct-desc? (or/c #f struct-info?) void?) + (c-> Struct? struct-names? struct-desc? (or/c #f struct-info?) (listof def-binding?)) (define tvars (struct-desc-tvars desc)) @@ -203,14 +203,20 @@ (add-struct-fn! s (make-StructPE poly-base i) #t) (cons s (poly-wrapper (->* (list poly-base t) -Void)))) null)))) + (add-struct-constructor! (struct-names-constructor names)) - (cons - (and si (make-def-struct-stx-binding (struct-names-type-name names) si)) - (for/list ([b bindings]) - (define id (car b)) - (define t (cdr b)) - (register-type id t) - (make-def-binding id t)))) + + (define def-bindings + (for/list ([b bindings]) + (define id (car b)) + (define t (cdr b)) + (register-type id t) + (make-def-binding id t))) + (if si + (cons + (make-def-struct-stx-binding (struct-names-type-name names) si) + def-bindings) + def-bindings)) (define (register-parsed-struct-sty! ps) (match ps