From cb45933a9d44cb83ad0cbe7f9dab6b759f84ae9d Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 30 Apr 2008 21:54:32 +0000 Subject: [PATCH] Remove uses of old inference. Add missing cases to new infer. svn: r9551 original commit: 5c3d329a1bbb5a226e3faec5d647ae9bc6adf81f --- .../typed-scheme/private/remove-intersect.ss | 30 ++----------------- 1 file changed, 2 insertions(+), 28 deletions(-) diff --git a/collects/typed-scheme/private/remove-intersect.ss b/collects/typed-scheme/private/remove-intersect.ss index 4ad90431..616fbb8e 100644 --- a/collects/typed-scheme/private/remove-intersect.ss +++ b/collects/typed-scheme/private/remove-intersect.ss @@ -1,10 +1,10 @@ #lang scheme/base (require "type-rep.ss" "unify.ss" "union.ss" "infer.ss" "subtype.ss" - "type-utils.ss" "resolve-type.ss" "type-effect-convenience.ss" + "type-utils.ss" "resolve-type.ss" "type-effect-convenience.ss" mzlib/plt-match mzlib/trace) -(provide restrict (rename-out [*remove remove]) overlap) +(provide (rename-out [*remove remove]) overlap) (define (overlap t1 t2) @@ -42,33 +42,7 @@ #f] [else #t])) -;; this is *definitely* not yet correct -;; NEW IMPL -;; restrict t1 to be a subtype of t2 -(define (restrict t1 t2) - ;; we don't use union map directly, since that might produce too many elements - (define (union-map f l) - (match l - [(Union: es) - (let ([l (map f es)]) - ;(printf "l is ~a~n" l) - (apply Un l))])) - (cond - [(subtype t1 t2) t1] ;; already a subtype - [(match t2 - [(Poly: vars t) - (let ([subst (infer t t1 vars)]) - (and subst (restrict t1 (subst-all subst t1))))] - [_ #f])] - [(Union? t1) (union-map (lambda (e) (restrict e t2)) t1)] - [(Mu? t1) - (restrict (unfold t1) t2)] - [(Mu? t2) (restrict t1 (unfold t2))] - [(subtype t2 t1) t2] ;; we don't actually want this - want something that's a part of t1 - [(not (overlap t1 t2)) (Un)] ;; there's no overlap, so the restriction is empty - [else t2] ;; t2 and t1 have a complex relationship, so we punt - )) ;(trace restrict)