From dd66ef95ce7e6ba09c0ba7da4f7e6eee758b9e89 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 25 May 2013 13:16:08 -0700 Subject: [PATCH] Share definition of erase-filter. original commit: edc3b60b676f230e627bf89b521c782a10980d1b --- collects/typed-racket/typecheck/tc-if.rkt | 6 ------ collects/typed-racket/typecheck/tc-let-unit.rkt | 8 +------- collects/typed-racket/types/filter-ops.rkt | 13 +++++++++++-- 3 files changed, 12 insertions(+), 15 deletions(-) diff --git a/collects/typed-racket/typecheck/tc-if.rkt b/collects/typed-racket/typecheck/tc-if.rkt index 6dab98b7..586125e5 100644 --- a/collects/typed-racket/typecheck/tc-if.rkt +++ b/collects/typed-racket/typecheck/tc-if.rkt @@ -15,12 +15,6 @@ (import tc-expr^) (export tc-if^) -(define (erase-filter tc) - (match tc - [(tc-any-results:) tc] - [(tc-results: ts _ _) - (ret ts (for/list ([f (in-list ts)]) (make-NoFilter)) (for/list ([f (in-list ts)]) (make-NoObject)))])) - (define (tc/if-twoarm tst thn els [expected #f]) (define (tc expr reachable?) (unless reachable? (warn-unreachable expr)) diff --git a/collects/typed-racket/typecheck/tc-let-unit.rkt b/collects/typed-racket/typecheck/tc-let-unit.rkt index a6eeba00..3a022939 100644 --- a/collects/typed-racket/typecheck/tc-let-unit.rkt +++ b/collects/typed-racket/typecheck/tc-let-unit.rkt @@ -2,7 +2,7 @@ (require "../utils/utils.rkt" (only-in srfi/1/list s:member) - (except-in (types utils abbrev union) -> ->* one-of/c) + (except-in (types utils abbrev union filter-ops) -> ->* one-of/c) (only-in (types abbrev) (-> t:->)) (private type-annotation parse-type syntax-properties) (env lexical-env type-alias-env global-env type-env-structs scoped-tvar-env) @@ -17,12 +17,6 @@ (import tc-expr^) (export tc-let^) -(define (erase-filter tc) - (match tc - [(tc-any-results:) tc] - [(tc-results: ts _ _) - (ret ts (for/list ([f (in-list ts)]) (make-NoFilter)) (for/list ([f (in-list ts)]) (make-NoObject)))])) - (define/cond-contract (do-check expr->type namess results expected-results form exprs body clauses expected #:abstract [abstract null]) (((syntax? syntax? tc-results/c . -> . any/c) (listof (listof identifier?)) (listof tc-results/c) (listof tc-results/c) diff --git a/collects/typed-racket/types/filter-ops.rkt b/collects/typed-racket/types/filter-ops.rkt index 1896d924..2695c67e 100644 --- a/collects/typed-racket/types/filter-ops.rkt +++ b/collects/typed-racket/types/filter-ops.rkt @@ -4,10 +4,10 @@ racket/list racket/match racket/dict (prefix-in c: (contract-req)) - (rep type-rep filter-rep rep-utils) + (rep type-rep filter-rep object-rep rep-utils) (utils tc-utils) (only-in (infer infer) restrict) - (types union subtype remove-intersect abbrev)) + (types union subtype remove-intersect abbrev tc-result)) (provide (all-defined-out)) @@ -203,3 +203,12 @@ (-and false-filter new-filters)) op))) rest drest kws))))])])) + +;; tc-results/c -> tc-results/c +(define (erase-filter tc) + (match tc + [(tc-any-results:) tc] + [(tc-results: ts _ _) + (ret ts + (for/list ([f (in-list ts)]) (make-NoFilter)) + (for/list ([f (in-list ts)]) (make-NoObject)))]))