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

Handle structs with special constructors and mutability.

Browse Source 
Closes PR 11089.

original commit: 3359032ad58d94c9447bf842d8abcf3ad98b41fd
This commit is contained in:
Sam Tobin-Hochstadt 2010-08-06 15:59:52 -04:00
parent 6369cdb91c
commit 4d5a707d99
2 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/typed-scheme/succeed/struct:-mutable.rkt Normal file
View File

@ -0,0 +1,6 @@
#lang typed/racket
(struct: foo ([x : Integer]) #:mutable)
(: f (Integer -> foo))
(define (f x) (foo x))

10
collects/typed-scheme/typecheck/tc-toplevel.rkt
View File

@ -97,6 +97,11 @@
(#%plain-app values)))
(tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...))
#:maker #'m)]
[(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...)
#:maker m #:mutable))
(#%plain-app values)))
(tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...))
#:maker #'m #:mutable #t)]
[(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...)
#:maker m))
(#%plain-app values)))
@ -107,7 +112,10 @@
(tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:type-only #t)]
;; define-typed-struct w/ polymorphism
[(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...))) (#%plain-app values)))
(tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)))]
(tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)))]
;; error in other cases
[(define-values () (begin (quote-syntax (define-typed-struct-internal . _)) (#%plain-app values)))
(int-err "unknown structure form")]
;; executable structs - this is a big hack
[(define-values () (begin (quote-syntax (define-typed-struct/exec-internal nm ([fld : ty] ...) proc-ty)) (#%plain-app values)))