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

Synthesize types for private fields in classes

Browse Source 
Allows type annotations to be left out in some cases

original commit: 9c63978a582c2b26be3121cbfd3759de81b7f97f
This commit is contained in:
Asumu Takikawa 2014-03-04 16:12:10 -05:00
parent 5aa1c61c04
commit 805cc5e686
2 changed files with 40 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
View File

@ -19,7 +19,7 @@
(private parse-type syntax-properties type-annotation)
(base-env class-prims)
(env lexical-env tvar-env)
(types utils abbrev union subtype resolve)
(types utils abbrev union subtype resolve generalize)
(typecheck check-below internal-forms)
(utils tc-utils)
(rep type-rep)
@ -399,15 +399,21 @@
local-super-table
local-augment-table local-inner-table)
(construct-local-mapping-tables (car locals)))
;; types for private elements
(define private-method-types
(for/hash ([(name type) (in-dict annotation-table)]
#:when (set-member? (hash-ref parse-info 'private-names) name))
(values name type)))
(define private-field-types
(for/hash ([(name type) (in-dict annotation-table)]
#:when (set-member? (hash-ref parse-info 'private-fields) name))
(values name (list type))))
(define private-field-types (make-hash))
(for ([(name type) (in-dict annotation-table)]
#:when (set-member? (hash-ref parse-info 'private-fields) name))
(hash-set! private-field-types name (list type)))
(synthesize-private-field-types top-level-exprs
local-private-field-table
private-field-types)
;; start type-checking elements in the body
(define-values (lexical-names lexical-types
lexical-names/top-level lexical-types/top-level)
@ -892,6 +898,31 @@
(tc-expr form)]
[_ (void)])))
;; synthesize-private-field-types : (Listof Syntax) Dict Hash -> Void
;; Given top-level expressions in the class, synthesize types from
;; the initialization expressions for private fields.
(define (synthesize-private-field-types exprs locals types)
(for ([(name getter+setter) (in-dict locals)]
#:unless (hash-has-key? types name))
(match-define (list _ setter) getter+setter)
;; only the first setter expression is the initialization for
;; the field, the rest are set!s in the user code
(for/or ([expr exprs])
(syntax-parse expr
#:literal-sets (kernel-literals)
[(let-values ([(obj) self])
(let-values ([(field) initial-value])
(#%plain-app setter* _ _)))
#:when (free-identifier=? setter #'setter*)
(define type (tc-expr/t #'initial-value))
;; FIXME: this always generalizes the private field
;; type, but it's better to only generalize if
;; the field is actually mutated.
(hash-set! types name (list (generalize type)))
;; done once we find the first one
#t]
[_ #f]))))
;; Syntax -> Dict<Symbol, Id> Dict<Symbol, Id>
;; Dict<Symbol, (List Symbol Symbol)> Dict<Symbol, Id>
;; Construct tables mapping internal method names to the accessors

7
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/class-tests.rkt
View File

@ -442,9 +442,10 @@
(: x Symbol)
(define x "foo"))
#:msg #rx"expected: Symbol.*given: String"]
;; fails, private field needs type annotation
[tc-err (class object% (super-new) (define x "foo"))
#:msg #rx"expected: Nothing"]
;; ok, synthesis works on private fields
[tc-e (class object% (super-new)
(define x "foo") (string-append x "bar"))
(-class)]
;; test private method
[tc-e (let ()
(class object% (super-new)