suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix sorting

Browse Source 
svn: r17270
This commit is contained in:
Sam Tobin-Hochstadt 2009-12-11 17:09:51 +00:00
parent 3e497704aa
commit dde2c1fb18
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/typed-scheme/types/subtype.ss
View File

@ -6,7 +6,9 @@
(env type-name-env) (env type-name-env)
(only-in (infer infer-dummy) unify) (only-in (infer infer-dummy) unify)
scheme/match unstable/match scheme/match unstable/match
mzlib/trace mzlib/trace (rename-in scheme/contract
[-> c->]
[->* c->*])
(for-syntax scheme/base syntax/parse)) (for-syntax scheme/base syntax/parse))
;; exn representing failure of subtyping ;; exn representing failure of subtyping
@ -179,7 +181,8 @@
;(trace subtypes*/varargs) ;(trace subtypes*/varargs)
(define (combine-arrs arrs) (d/c (combine-arrs arrs)
(c-> (listof arr?) (or/c #f arr?))
(match arrs (match arrs
[(list (arr: dom1 rng1 #f #f '()) (arr: dom rng #f #f '()) ...) [(list (arr: dom1 rng1 #f #f '()) (arr: dom rng #f #f '()) ...)
(cond (cond
@ -188,7 +191,7 @@
#f) #f)
((not (foldl type-equal? rng1 rng)) ((not (foldl type-equal? rng1 rng))
#f) #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<?))) (cons dom1 dom)) rng1 #f #f '())])]
[_ #f])) [_ #f]))