Fix a TR bug for row polymorphic application

The domains in a row polymorphic function weren't checked
properly when row inference was used.

original commit: 32f09c35705206a281fcd1f02b968c7ad02ece69
This commit is contained in:
Asumu Takikawa 2014-02-27 18:14:49 -05:00
parent 3bda5906bf
commit 133a961596
2 changed files with 11 additions and 7 deletions

View File

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

View File

@ -835,6 +835,14 @@
(inst f #:row (field [y Integer])))
(instantiated
(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
[tc-e (let ()
(: f (All (A #:row (field x))