diff --git a/typed-racket-lib/typed-racket/base-env/prims-struct.rkt b/typed-racket-lib/typed-racket/base-env/prims-struct.rkt index 09dc4f38..0cc2f20d 100644 --- a/typed-racket-lib/typed-racket/base-env/prims-struct.rkt +++ b/typed-racket-lib/typed-racket/base-env/prims-struct.rkt @@ -128,13 +128,15 @@ [(_ vars:maybe-type-vars nm:struct-name (fs:fld-spec ...) opts:struct-options) (let ([mutable? (if (attribute opts.mutable?) #'(#:mutable) #'())] - [cname (second (build-struct-names #'nm.name null #t #t))]) + [cname (second (build-struct-names #'nm.name null #t #t))] + [prefab? (if (attribute opts.prefab?) #'(#:prefab) #'())]) (with-syntax ([d-s (ignore-some (syntax/loc stx (define-struct nm (fs.fld ...) . opts)))] [dtsi (quasisyntax/loc stx (dtsi* (vars.vars ...) nm (fs.form ...) #:maker #,cname - #,@mutable?))]) + #,@mutable? + #,@prefab?))]) #'(begin d-s dtsi)))])) (lambda (stx) (syntax-parse stx diff --git a/typed-racket-test/succeed/prefab.rkt b/typed-racket-test/succeed/prefab.rkt index 7dd06b1d..e3bc8faf 100644 --- a/typed-racket-test/succeed/prefab.rkt +++ b/typed-racket-test/succeed/prefab.rkt @@ -4,6 +4,8 @@ (struct foo ([x : Symbol]) #:prefab) (struct bar foo ([y : String] [z : String]) #:prefab) +(define-struct foo* ([x : Symbol]) #:prefab) +(define-struct (bar* foo*) ([y : String] [z : String]) #:prefab) (: a-bar (Prefab (bar foo 1) Symbol String String)) (define a-bar (bar 'foo "bar1" "bar2")) @@ -11,6 +13,9 @@ (foo-x (foo 'foo)) (bar-y (bar 'foo "bar1" "bar2")) +(foo*-x (make-foo* 'foo)) +(bar*-y (make-bar* 'foo "bar1" "bar2")) + ;; prefab keys may be normalized or not (: a-bar-2 (Prefab (bar 2 foo 1 (0 #f) #()) Symbol String String)) (define a-bar-2 (bar 'foo "bar1" "bar2")) @@ -22,18 +27,29 @@ ;; Mutable prefab structs (struct baz ([x : String]) #:mutable #:prefab) +(define-struct baz* ([x : String]) #:mutable #:prefab) (define a-baz (baz "baz")) (set-baz-x! a-baz "baz2") (baz-x a-baz) +(define a-baz* (make-baz* "baz")) +(set-baz*-x! a-baz* "baz2") +(baz*-x a-baz*) + ;; Polymorphic prefab structs (struct (X) poly ([x : X]) #:prefab) +(define-struct (X) poly* ([x : X]) #:prefab) (poly-x (poly "foo")) (poly-x (poly 3)) (poly-x #s(poly "foo")) +(poly*-x (make-poly* "foo")) +(poly*-x (make-poly* 3)) +(poly*-x #s(poly* "foo")) + ;; Test match (indirectly tests unsafe-struct-ref) (match (foo 'x) [(foo s) s]) +(match (foo* 'x) [(foo* s) s])