From 55fb37ff164d5757d721eda56cadd7ad9fe99e46 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 3 May 2010 13:15:19 -0400 Subject: [PATCH] fix problem reported by Sigrid on plt-scheme original commit: 996405af9c5ba32c49d1051c85b573d1383e244a --- .../tests/typed-scheme/succeed/mutable-struct-pred.ss | 10 ++++++++++ collects/typed-scheme/typecheck/tc-structs.rkt | 4 +++- 2 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 collects/tests/typed-scheme/succeed/mutable-struct-pred.ss diff --git a/collects/tests/typed-scheme/succeed/mutable-struct-pred.ss b/collects/tests/typed-scheme/succeed/mutable-struct-pred.ss new file mode 100644 index 00000000..fbc998e6 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/mutable-struct-pred.ss @@ -0,0 +1,10 @@ +#lang typed/scheme + +(define-struct: x ([y : Any]) #:mutable) + +(define: the-x : Any (make-x 1)) + +(if (x? the-x) + (x-y the-x) + 0) + diff --git a/collects/typed-scheme/typecheck/tc-structs.rkt b/collects/typed-scheme/typecheck/tc-structs.rkt index 510b3422..6717d50b 100644 --- a/collects/typed-scheme/typecheck/tc-structs.rkt +++ b/collects/typed-scheme/typecheck/tc-structs.rkt @@ -111,6 +111,7 @@ #:maker (or maker* maker) #:predicate (or pred* pred) #:struct-info si + #:poly? poly? #:constructor-return cret)))) ;; generate names, and register the approriate types give field types and structure type @@ -123,6 +124,7 @@ #:pred-wrapper [pred-wrapper values] #:maker [maker* #f] #:predicate [pred* #f] + #:poly? [poly? #f] #:constructor-return [cret #f]) ;; create the approriate names that define-struct will bind (define-values (struct-type-id maker pred getters setters) (struct-names nm flds setters?)) @@ -137,7 +139,7 @@ (cons (or maker* maker) (wrapper (->* external-fld-types (if cret cret name)))) (cons (or pred* pred) - (make-pred-ty (if setters? + (make-pred-ty (if (and setters? poly?) (make-StructTop sty) (pred-wrapper name))))) (for/list ([g (in-list getters)] [t (in-list external-fld-types/no-parent)] [i (in-naturals)])