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

Fix handling of mutable structs (setters != getters)

Browse Source 
Allow use of #:mutable as define-typed-struct arg
Fix types of random andmap ormap

original commit: 2456dcc18b10a10a7bad3b1f9af8e33fad03231f
This commit is contained in:
Sam Tobin-Hochstadt 2008-07-13 17:31:58 -04:00
parent 5a2792932f
commit d77d7ba57f
2 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/typed-scheme/private/base-env.ss
View File

@ -105,8 +105,8 @@
[read (cl->
[(-Port) -Sexp]
[() -Sexp])]
[ormap (-polydots (a b) (->... (list (->... (list a) (b b) B) (-lst a)) ((-lst b) b) B))]
[andmap (-polydots (a b) (->... (list (->... (list a) (b b) B) (-lst a)) ((-lst b) b) B))]
[ormap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
[andmap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
[newline (cl-> [() -Void]
[(-Port) -Void])]
[not (-> Univ B)]
@ -256,8 +256,8 @@
[(-Pathlike (-> a) Sym) a]))]
[random (cl->
[(N) N]
[() N])]
[(-Integer) -Integer]
[() -Integer])]
[assoc (-poly (a b) (a (-lst (-pair a b)) . -> . (-opt (-pair a b))))]
[assf (-poly (a b)

11
collects/typed-scheme/private/prims.ss
View File

@ -305,10 +305,13 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntax (define-typed-struct stx)
(syntax-case stx (:)
[(_ nm ([fld : ty] ...) . opts)
(with-syntax ([d-s (syntax-property (syntax/loc stx (define-struct nm (fld ...) . opts))
'typechecker:ignore #t)]
[dtsi (internal (syntax/loc stx (define-typed-struct-internal nm ([fld : ty] ...))))])
#'(begin d-s dtsi))]
(let ([mutable (if (memq '#:mutable (syntax->datum #'opts))
'(#:mutable)
'())])
(with-syntax ([d-s (syntax-property (syntax/loc stx (define-struct nm (fld ...) . opts))
'typechecker:ignore #t)]
[dtsi (internal (quasisyntax/loc stx (define-typed-struct-internal nm ([fld : ty] ...) #,@mutable)))])
#'(begin d-s dtsi)))]
[(_ (vars ...) nm ([fld : ty] ...) . opts)
(with-syntax ([d-s (syntax-property (syntax/loc stx (define-struct nm (fld ...) . opts))
'typechecker:ignore #t)]