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

Add missing bits to type and ignore tables for make-object-related code.

Browse Source
This commit is contained in:
Vincent St-Amour 2015-10-16 10:47:24 -05:00
parent 36a40b8334
commit 22bfce117b
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt
View File

@ -7,7 +7,7 @@
racket/format
racket/list
(typecheck signatures)
(types base-abbrev resolve subtype union utils)
(types base-abbrev resolve subtype type-table union utils)
(rep type-rep)
(utils tc-utils)
@ -25,10 +25,21 @@
(define-tc/app-syntax-class (tc/app-objects expected)
#:literal-sets (kernel-literals object-literals)
(pattern (dmo b cl
(#%plain-app list . pos-args)
(#%plain-app list (#%plain-app cons (quote names) named-args) ...))
(~and pos-arg-list (#%plain-app list . pos-args))
(~and named-arg-list (#%plain-app list (#%plain-app cons (quote names) named-args) ...)))
#:declare dmo (id-from 'do-make-object 'racket/private/class-internal)
(check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...)))
(begin0
(check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...))
;; synthesize a type for #'pos-arg-list, for the optimizer
(add-typeof-expr #'pos-arg-list
(ret (for/fold ([res (-val '())])
([a (in-list (reverse (syntax->list #'pos-args)))])
(-pair (match (type-of a) [(tc-result1: t) t])
res))))
;; making the optimizer ignore named args is conservative, but safe
;; if we could give #'named-arg-list a type, then we'd be able to
;; optimize it
(register-ignored! #'named-arg-list)))
(pattern (dmo . args)
#:declare dmo (id-from 'do-make-object 'racket/private/class-internal)
(int-err "unexpected arguments to do-make-object"))