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

Fuse loops in promote-demote.

Browse Source
This commit is contained in:
Eric Dobson 2014-05-27 09:02:33 -07:00
parent 2b33b8d966
commit d2d9b2cce3
1 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt
View File

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