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

Use dmap code.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2008-06-13 09:55:03 -04:00
parent e2c0b4e642
commit 7cecac2579
1 changed files with 6 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/typed-scheme/private/constraints.ss
View File

@ -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)))