diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index 00c6d8e7..348d36af 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -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) diff --git a/collects/typed-scheme/private/prims.ss b/collects/typed-scheme/private/prims.ss index 2414b552..5c838d63 100644 --- a/collects/typed-scheme/private/prims.ss +++ b/collects/typed-scheme/private/prims.ss @@ -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)]