From cbec4bd4e5f052f7beeaecf3564f1b54a73f24f0 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Thu, 29 May 2014 19:30:54 -0700 Subject: [PATCH] Substitute into the dotted type of tc-results. original commit: 911b3ee8ee0fc99a070d0be5d1af0a79b21f4b64 --- .../typed-racket/typecheck/tc-subst.rkt | 17 ++++++++++++----- .../unit-tests/metafunction-tests.rkt | 6 ++++++ 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt index 7c86c63a..a44af4f1 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt @@ -18,7 +18,7 @@ (define (open-Values v os ts) (match v [(AnyValues: f) - (tc-any-results (open-Filter f os ts))] + (tc-any-results (open-Filter f os))] [(Values: results) (define-values (t-r f-r o-r) (for/lists (t-r f-r o-r) @@ -30,14 +30,21 @@ (for/lists (t-r f-r o-r) ([r (in-list results)]) (open-Result r os ts))) - (ret t-r f-r o-r dty dbound)])) + (ret t-r f-r o-r (open-Type dty os) dbound)])) -(define/cond-contract (open-Filter f objs ts) +(define/cond-contract (open-Type t objs) + (-> (Type/c (listof Object?) (listof Type/c) Filter/c)) + (for/fold ([t t]) + ([(o arg) (in-indexed (in-list objs))]) + (define key (list 0 arg)) + (subst-type t key o #t))) + + +(define/cond-contract (open-Filter f objs) (-> (Filter/c (listof Object?) (listof Type/c) Filter/c)) (for/fold ([f f]) - ([(o arg) (in-indexed (in-list objs))] - [arg-ty (in-list ts)]) + ([(o arg) (in-indexed (in-list objs))]) (define key (list 0 arg)) (subst-filter f key o #t))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt index 1d434b32..c03ea76b 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt @@ -139,5 +139,11 @@ (tc-any-results (-filter -String #'x))) + (check-equal? + (open-Values (-values-dots null (-> Univ -Boolean : (-FS (-filter -String '(1 0)) -top)) 'b) + (list (make-Path null #'x)) (list Univ)) + (ret null null null (-> Univ -Boolean : (-FS (-filter -String #'x) -top)) 'b)) + + ) ))