From 7cecac257993037aafac24f3b5cb53ac0235f83b Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 13 Jun 2008 09:55:03 -0400 Subject: [PATCH] Use dmap code. --- collects/typed-scheme/private/constraints.ss | 27 +++++--------------- 1 file changed, 6 insertions(+), 21 deletions(-) diff --git a/collects/typed-scheme/private/constraints.ss b/collects/typed-scheme/private/constraints.ss index b016c594ca..f5308b0637 100644 --- a/collects/typed-scheme/private/constraints.ss +++ b/collects/typed-scheme/private/constraints.ss @@ -30,9 +30,7 @@ ;; maps is a list of pairs of ;; - functional maps from vars to c's -;; - functional mappings from vars to either -;; - a list of vars generated for ... -;; - a clist containing possible constraints on the ... bound +;; - dmaps (see dmap.ss) ;; we need a bunch of mappings for each cset to handle case-lambda ;; because case-lambda can generate multiple possible solutions, and we ;; don't want to rule them out too early @@ -90,28 +88,15 @@ ([(map1 dmap1) (in-pairs maps1)] [(map2 dmap2) (in-pairs maps2)]) (with-handlers ([exn:infer? (lambda (_) #f)]) - (let* ([new-dmap (hash-union dmap1 dmap2 - (lambda (k vars1 vars2) - (cond [(and (list? vars1) (list? vars2)) - (unless (= (length vars1) (length vars2)) - (fail! vars1 vars2)) - vars1] - [else - (int-err "nyi : stars and dots together: ~a ~a" vars1 vars2)])))] - [subst - (apply append - (for/list ([(dvar vars) dmap1]) - (let ([vars2 (hash-ref dmap2 dvar #f)]) - (if vars2 (map list vars2 (map make-F vars)) null))))]) - (cons - (hash-union map1 map2 (lambda (k v1 v2) (c-meet v1 (subst-all/c subst v2)))) - new-dmap)))))]) + (cons + (hash-union map1 map2 (lambda (k v1 v2) (c-meet v1 v2))) + (dmap-meet dmap1 dmap2)))))]) (when (null? maps) (fail! maps1 maps2)) (make-cset maps))])) -(define (cset-meet* X args) - (for/fold ([c (empty-cset X)]) +(define (cset-meet* args) + (for/fold ([c (make-immutable-hash null)]) ([a args]) (cset-meet a c)))