Add fixed part to dcon-dotted.
This commit is contained in:
parent
339add9f78
commit
3f7ca52e37
|
@ -18,9 +18,10 @@
|
||||||
;; rest : c
|
;; rest : c
|
||||||
(d-s/c dcon-exact ([fixed (listof c?)] [rest c?]) #:transparent)
|
(d-s/c dcon-exact ([fixed (listof c?)] [rest c?]) #:transparent)
|
||||||
|
|
||||||
|
;; fixed : Listof[c]
|
||||||
;; type : c
|
;; type : c
|
||||||
;; bound : var
|
;; 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?))
|
(define dcon/c (or/c dcon? dcon-exact? dcon-dotted?))
|
||||||
|
|
||||||
|
|
|
@ -52,10 +52,13 @@
|
||||||
[c2 (in-sequence-forever shorter srest)])
|
[c2 (in-sequence-forever shorter srest)])
|
||||||
(c-meet c1 c2 (c-X c1)))
|
(c-meet c1 c2 (c-X c1)))
|
||||||
(c-meet lrest srest (c-X lrest))))]
|
(c-meet lrest srest (c-X lrest))))]
|
||||||
[((struct dcon-dotted (c1 bound1)) (struct dcon-dotted (c2 bound2)))
|
[((struct dcon-dotted (fixed1 c1 bound1)) (struct dcon-dotted (fixed2 c2 bound2)))
|
||||||
(unless (eq? bound1 bound2)
|
(unless (and (= (length fixed1) (length fixed2))
|
||||||
|
(eq? bound1 bound2))
|
||||||
(fail! 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 _))
|
[((struct dcon _) (struct dcon-dotted _))
|
||||||
(fail! dc1 dc2)]
|
(fail! dc1 dc2)]
|
||||||
[((struct dcon-dotted _) (struct dcon _))
|
[((struct dcon-dotted _) (struct dcon _))
|
||||||
|
|
|
@ -29,23 +29,6 @@
|
||||||
(define (seen? s t) (member (seen-before s t) (current-seen)))
|
(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)
|
(define (map/cset f cset)
|
||||||
(make-cset (for/list ([(cmap dmap) (in-pairs (cset-maps cset))])
|
(make-cset (for/list ([(cmap dmap) (in-pairs (cset-maps cset))])
|
||||||
(f cmap dmap))))
|
(f cmap dmap))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user