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

Add fixed part to dcon-dotted.

Browse Source
This commit is contained in:
Stevie Strickland 2010-06-18 15:22:59 -04:00 committed by Sam Tobin-Hochstadt
parent 339add9f78
commit 3f7ca52e37
3 changed files with 8 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/typed-scheme/infer/constraint-structs.rkt
View File

@ -18,9 +18,10 @@
;; rest : c
(d-s/c dcon-exact ([fixed (listof c?)] [rest c?]) #:transparent)
;; fixed : Listof[c]
;; type : c
;; bound : var
(d-s/c dcon-dotted ([type c?] [bound symbol?]) #:transparent)
(d-s/c dcon-dotted ([fixed (listof c?)] [type c?] [bound symbol?]) #:transparent)
(define dcon/c (or/c dcon? dcon-exact? dcon-dotted?))

9
collects/typed-scheme/infer/dmap.rkt
View File

@ -52,10 +52,13 @@
[c2 (in-sequence-forever shorter srest)])
(c-meet c1 c2 (c-X c1)))
(c-meet lrest srest (c-X lrest))))]
[((struct dcon-dotted (c1 bound1)) (struct dcon-dotted (c2 bound2)))
(unless (eq? bound1 bound2)
[((struct dcon-dotted (fixed1 c1 bound1)) (struct dcon-dotted (fixed2 c2 bound2)))
(unless (and (= (length fixed1) (length fixed2))
(eq? bound1 bound2))
(fail! bound1 bound2))
(make-dcon-dotted (c-meet c1 c2 bound1) bound1)]
(make-dcon-dotted (for/list ([c1 fixed1] [c2 fixed2])
(c-meet c1 c2 (c-X c1)))
(c-meet c1 c2 bound1) bound1)]
[((struct dcon _) (struct dcon-dotted _))
(fail! dc1 dc2)]
[((struct dcon-dotted _) (struct dcon _))

17
collects/typed-scheme/infer/infer-unit.rkt
View File

@ -29,23 +29,6 @@
(define (seen? s t) (member (seen-before s t) (current-seen)))
(define (dmap-constraint dmap dbound v)
(let ([dc (hash-ref dmap dbound #f)])
(match dc
[(struct dcon (fixed #f))
(if (eq? dbound v)
(no-constraint v)
(hash-ref fixed v (no-constraint v)))]
[(struct dcon (fixed rest))
(if (eq? dbound v)
rest
(hash-ref fixed v (no-constraint v)))]
[(struct dcon-dotted (type bound))
(if (eq? bound v)
type
(no-constraint v))]
[_ (no-constraint v)])))
(define (map/cset f cset)
(make-cset (for/list ([(cmap dmap) (in-pairs (cset-maps cset))])
(f cmap dmap))))