From 43c534dbdfe70b08692d1bfb92fa45448583dfe3 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 11 Dec 2009 17:09:51 +0000 Subject: [PATCH] fix sorting svn: r17270 original commit: dde2c1fb18fa716928af955d889f205caacbc378 --- collects/typed-scheme/types/subtype.ss | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/types/subtype.ss b/collects/typed-scheme/types/subtype.ss index be894406..3f6e8303 100644 --- a/collects/typed-scheme/types/subtype.ss +++ b/collects/typed-scheme/types/subtype.ss @@ -6,7 +6,9 @@ (env type-name-env) (only-in (infer infer-dummy) unify) scheme/match unstable/match - mzlib/trace + mzlib/trace (rename-in scheme/contract + [-> c->] + [->* c->*]) (for-syntax scheme/base syntax/parse)) ;; exn representing failure of subtyping @@ -179,7 +181,8 @@ ;(trace subtypes*/varargs) -(define (combine-arrs arrs) +(d/c (combine-arrs arrs) + (c-> (listof arr?) (or/c #f arr?)) (match arrs [(list (arr: dom1 rng1 #f #f '()) (arr: dom rng #f #f '()) ...) (cond @@ -188,7 +191,7 @@ #f) ((not (foldl type-equal? rng1 rng)) #f) - [else (make-arr (apply map (lambda args (make-Union args)) (cons dom1 dom)) rng1 #f #f '())])] + [else (make-arr (apply map (lambda args (make-Union (sort args type