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

Fix a TR bug for row polymorphic application

Browse Source 
The domains in a row polymorphic function weren't checked
properly when row inference was used.
This commit is contained in:
Asumu Takikawa 2014-02-27 18:14:49 -05:00
parent 4491b6a687
commit 32f09c3570
2 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
View File

@ -119,9 +119,7 @@
(and t (PolyRow: (and t (PolyRow:
vars vars
constraints constraints
(Function: (list (and arrs (arr: doms rngs rests (and drests #f) (and f-ty (Function: (list (arr: doms _ _ #f _) ...))))))
(list (Keyword: _ _ kw?) ...)))
...)))))
(list (tc-result1: argtys-t) ...)) (list (tc-result1: argtys-t) ...))
(define (fail) (define (fail)
(poly-fail f-stx args-stx t argtys (poly-fail f-stx args-stx t argtys
@ -149,10 +147,8 @@
(define substitution (define substitution
(hash row-var (hash row-var
(t-subst (infer-row constraints (list-ref argtys-t idx))))) (t-subst (infer-row constraints (list-ref argtys-t idx)))))
(or (for/or ([arr (in-list arrs)]) (tc/funapp f-stx args-stx (ret (subst-all substitution f-ty))
(tc/funapp1 f-stx args-stx (subst-all substitution arr) argtys expected)]
argtys expected #:check #f))
(fail))]
[else (fail)])] [else (fail)])]
;; procedural structs ;; procedural structs
[((tc-result1: (and sty (Struct: _ _ _ (? Function? proc-ty) _ _))) _) [((tc-result1: (and sty (Struct: _ _ _ (? Function? proc-ty) _ _))) _)

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

@ -835,6 +835,14 @@
(inst f #:row (field [y Integer]))) (inst f #:row (field [y Integer])))
(instantiated (instantiated
(class object% (super-new))))] (class object% (super-new))))]
;; fails, the argument object lacks required fields (with inference)
[tc-err (let ()
(: mixin (All (r #:row)
(-> (Class (field [x Any]) #:row-var r)
(Class (field [x Any]) #:row-var r))))
(define (mixin cls) cls)
(mixin object%))
#:msg (regexp-quote "expected: (Class (field (x Any)))")]
;; mixin application succeeds ;; mixin application succeeds
[tc-e (let () [tc-e (let ()
(: f (All (A #:row (field x)) (: f (All (A #:row (field x))