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

Track mutable variables across modules.

Browse Source 
original commit: eed93825abcedc07570b4a185b88ad30f424cf0f
This commit is contained in:
Sam Tobin-Hochstadt 2012-08-31 17:29:33 -04:00
parent d5b1f76319
commit 6d73aa7b4d
12 changed files with 64 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/tests/typed-racket/fail/other-module-mutation.rkt Normal file
View File

@ -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)

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

@ -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)])
(tc-expr ex)))
(find-mutated-vars ex mvar-env)
(tc-expr ex))
#,(syntax-local-eval #'b)))]))
(define (typecheck-special-tests)

10
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -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)])
(values (lambda () (tc-expr ex)) ex))))]))
(find-mutated-vars ex mvar-env)
(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)])
(tc-expr ex))))]))
(find-mutated-vars ex mvar-env)
(tc-expr ex)))]))
;; check that an expression typechecks correctly
(define-syntax (tc-e stx)

9
collects/typed-racket/env/init-envs.rkt vendored
View File

@ -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))))

3
collects/typed-racket/env/lexical-env.rkt vendored
View File

@ -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) -> ->*))

13
collects/typed-racket/env/mvar-env.rkt vendored Normal file
View File

@ -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))

2
collects/typed-racket/optimizer/unboxed-let.rkt
View File

@ -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)

2
collects/typed-racket/private/type-annotation.rkt
View File

@ -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)

6
collects/typed-racket/tc-setup.rkt
View File

@ -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)]
[orig-module-stx (or (orig-module-stx) orig-stx)]
(find-mutated-vars fully-expanded-stx mvar-env)
(parameterize ([orig-module-stx (or (orig-module-stx) orig-stx)]
[expanded-module-stx fully-expanded-stx]
[debugging? #f])
(do-time "Starting `checker'")

3
collects/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -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

1
collects/typed-racket/types/abbrev.rkt
View File

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

6
collects/typed-racket/utils/tc-utils.rkt
View File

@ -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]