Track mutable variables across modules.

collects/tests/typed-racket/fail/other-module-mutation.rkt

@@ -0,0 +1,25 @@
+#lang racket/load
+
+(module mutator typed/racket
+   (define: y : Integer 0)
+
+   (: set-y! (Integer -> Void))
+   (define (set-y! v)
+     (set! y v))
+
+   (provide y set-y!))
+
+(module user typed/racket
+   (require 'mutator)
+
+   (: foo (Zero -> Zero))
+   (define (foo y)
+     (printf "(foo ~v)~n" y)
+     y)
+
+   (cond [(zero? y) (set-y! 10)
+                     (foo y)]
+         [else y]))
+
+(require 'user)
+

collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt

@@ -17,7 +17,7 @@
          racket/file racket/port
          (for-syntax syntax/kerncase syntax/parse racket/syntax
                      (types abbrev numeric-tower utils)
-                     (utils mutated-vars)
+                     (utils mutated-vars) (env mvar-env)
                      (utils tc-utils) (typecheck typechecker))
          typed-racket/base-env/prims
          typed-racket/base-env/base-types
@@ -34,8 +34,8 @@
      (quasisyntax/loc stx
        (check-tc-result-equal? (format "~a ~a" #,(syntax-line stx) 'a)
                                #,(let ([ex (local-expand #'a 'expression null)])
-                                   (parameterize ([mutated-vars (find-mutated-vars ex)])
+	                           (find-mutated-vars ex mvar-env)
-                                     (tc-expr ex))) 
+                                   (tc-expr ex))
                                #,(syntax-local-eval #'b)))]))
 
 (define (typecheck-special-tests)

collects/tests/typed-racket/unit-tests/typecheck-tests.rkt

@@ -21,7 +21,7 @@
                     [-> t:->])
          (utils tc-utils utils)
          (utils mutated-vars)
-         (env type-name-env type-env-structs init-envs)
+         (env type-name-env type-env-structs init-envs mvar-env)
          rackunit rackunit/text-ui
          syntax/parse
          (for-syntax (utils tc-utils) racket/file racket/port
@@ -75,8 +75,8 @@
                       [current-namespace (namespace-anchor->namespace anch)]
                       [orig-module-stx (quote-syntax e)])
          (let ([ex (expand 'e)])
-           (parameterize ([mutated-vars (find-mutated-vars ex)])
+	   (find-mutated-vars ex mvar-env)
-             (values (lambda () (tc-expr ex)) ex))))]))
+           (values (lambda () (tc-expr ex)) ex)))]))
 
 (define-syntax (tc-expr/expand stx)
   (syntax-case stx ()
@@ -85,8 +85,8 @@
                       [current-namespace (namespace-anchor->namespace anch)]
                       [orig-module-stx (quote-syntax e)])
          (let ([ex (expand 'e)])
-           (parameterize ([mutated-vars (find-mutated-vars ex)])
+           (find-mutated-vars ex mvar-env)
-             (tc-expr ex))))]))
+           (tc-expr ex)))]))
 
 ;; check that an expression typechecks correctly
 (define-syntax (tc-e stx)

collects/typed-racket/env/init-envs.rkt

@@ -5,12 +5,13 @@
          "global-env.rkt"
          "type-name-env.rkt"
          "type-alias-env.rkt"
+         "mvar-env.rkt"
          (rep type-rep object-rep filter-rep rep-utils)
          (for-template (rep type-rep object-rep filter-rep)
                        (types union abbrev)
                        racket/shared racket/base)
          (types abbrev)
-         racket/syntax
+         racket/syntax racket/dict
          mzlib/pconvert racket/match)
 
 (define (initialize-type-name-env initial-type-names)
@@ -102,5 +103,11 @@
                  (booleans-as-true/false #f))
     #`(begin #,@(filter values (type-env-map f)))))
 
+(define (mvar-env-init-code mvar-env)
+  (define (f id v)
+    (and v (bound-in-this-module id)
+         #`(register-mutated-var #'#,id)))
+  #`(begin #,@(filter values (dict-map mvar-env f))))
+
 
 

collects/typed-racket/env/lexical-env.rkt

@@ -10,11 +10,12 @@
          "type-env-structs.rkt"
          "global-env.rkt"
          "../types/kw-types.rkt"
+         "mvar-env.rkt"
          syntax/id-table
          racket/keyword-transform racket/list
          (for-syntax syntax/parse syntax/parse/experimental/contract racket/base)
          (only-in racket/contract ->* -> or/c any/c listof cons/c)
-         (utils tc-utils mutated-vars)
+         (utils tc-utils)
          (only-in (rep type-rep) Type/c)
          (typecheck tc-metafunctions)
          (except-in (types utils abbrev) -> ->*))

collects/typed-racket/env/mvar-env.rkt

@@ -0,0 +1,13 @@
+#lang racket/base
+
+(require syntax/id-table racket/dict)
+
+(provide mvar-env register-mutated-var is-var-mutated?)
+
+(define mvar-env (make-free-id-table))
+
+(define (register-mutated-var id)
+  (dict-set! mvar-env id #t))
+
+(define (is-var-mutated? id)
+  (dict-ref mvar-env id #f))

collects/typed-racket/optimizer/unboxed-let.rkt

@@ -6,7 +6,7 @@
          "../utils/tc-utils.rkt"
          (for-template racket/base)
          (types numeric-tower utils type-table)
-         (rep type-rep)
+         (rep type-rep) (env mvar-env)
          (optimizer utils logging float-complex))
 
 (provide unboxed-let-opt-expr)

collects/typed-racket/private/type-annotation.rkt

@@ -3,7 +3,7 @@
 (require "../utils/utils.rkt"
 	 (rep type-rep)
 	 (utils tc-utils)
-	 (env global-env)
+	 (env global-env mvar-env)
          (except-in (types subtype union resolve utils generalize))
          (private parse-type)
          (contract-req)

collects/typed-racket/tc-setup.rkt

@@ -6,7 +6,7 @@
          (private type-contract)
          (types utils)
          (typecheck typechecker provide-handling tc-toplevel)
-         (env tvar-env type-name-env type-alias-env env-req)
+         (env tvar-env type-name-env type-alias-env env-req mvar-env)
          (utils tc-utils disarm mutated-vars debug)
          (rep type-rep)
          (for-syntax racket/base)
@@ -58,8 +58,8 @@
         (do-time "Local Expand Done")
         (init)
         (do-time "Initialized Envs")
-        (parameterize ([mutated-vars (find-mutated-vars fully-expanded-stx)]
+        (find-mutated-vars fully-expanded-stx mvar-env)
-                       [orig-module-stx (or (orig-module-stx) orig-stx)]
+        (parameterize ([orig-module-stx (or (orig-module-stx) orig-stx)]
                        [expanded-module-stx fully-expanded-stx]
                        [debugging? #f])
           (do-time "Starting `checker'")

collects/typed-racket/typecheck/tc-toplevel.rkt

@@ -13,7 +13,7 @@
          (rep type-rep)
          (types utils abbrev type-table)
          (private parse-type type-annotation type-contract)
-         (env global-env init-envs type-name-env type-alias-env lexical-env env-req)
+         (env global-env init-envs type-name-env type-alias-env lexical-env env-req mvar-env)
          syntax/id-table
          (utils tc-utils mutated-vars)
          "provide-handling.rkt"
@@ -350,6 +350,7 @@
               #,(env-init-code syntax-provide? provide-tbl def-tbl)
               #,(talias-env-init-code)
               #,(tname-env-init-code)
+              #,(mvar-env-init-code mvar-env)
               #,(make-struct-table-code)
               #,@(for/list ([a (in-list aliases)])
                    (match a

collects/typed-racket/types/abbrev.rkt

@@ -6,6 +6,7 @@
          (utils tc-utils)
          "base-abbrev.rkt"
          (types union numeric-tower)
+         (env mvar-env)
          racket/list
          racket/match
          racket/function

collects/typed-racket/utils/tc-utils.rkt

@@ -15,12 +15,6 @@ don't depend on any other portion of the system
 (define orig-module-stx (make-parameter #f))
 (define expanded-module-stx (make-parameter #f))
 
-;; a parameter holding the mutated variables for the form currently being
-;; checked
-(define mutated-vars (make-parameter #hash()))
-
-(define (is-var-mutated? id) (dict-ref (mutated-vars) id #f))
-
 (define (stringify l [between " "])
   (define (intersperse v l)
     (cond [(null? l) null]