Fuse loops in promote-demote.

This commit is contained in:
Eric Dobson 2014-05-27 09:02:33 -07:00
parent 2b33b8d966
commit d2d9b2cce3

View File

@ -37,12 +37,9 @@
(define (co t) (structural-recur t 'co))
(define (contra t) (structural-recur t 'contra))
(match T
[(F: name) (if (memq name V) (if change Univ -Bottom) T)]
[(Function: arrs)
(make-Function
(filter values
(for/list ([arr (in-list arrs)])
;; arr? -> (or/c #f arr?)
;; Returns the changed arr or #f if there is no arr above it
(define (arr-change arr)
(match arr
[(arr: dom rng rest drest kws)
(cond
@ -59,7 +56,12 @@
(co rng)
(and rest (contra rest))
(and drest (cons (contra (car drest)) (cdr drest)))
(map contra kws))])]))))]
(map contra kws))])]))
(match T
[(F: name) (if (memq name V) (if change Univ -Bottom) T)]
[(Function: arrs)
(make-Function (filter-map arr-change arrs))]
[(? structural?) (structural-map T structural-recur)]
[(? Filter?) ((sub-f co) T)]
[(? Object?) ((sub-o co) T)]