Generate dcon-dotted, and substitute for them.
- generated only in the case where we have two ListDots or two ValuesDots - or when -> with the same bound, and fixed argument lengts are identical - currently errors if there are any 'fixed' portions
This commit is contained in:
parent
9c22701bd3
commit
034b22d014
|
@ -76,6 +76,19 @@
|
||||||
(hash-ref cmap dbound
|
(hash-ref cmap dbound
|
||||||
(λ () (int-err "No constraint for bound ~a" dbound)))))))
|
(λ () (int-err "No constraint for bound ~a" dbound)))))))
|
||||||
|
|
||||||
|
;; dbound : index variable
|
||||||
|
;; cset : the constraints being manipulated
|
||||||
|
;;
|
||||||
|
(d/c (move-dotted-rest-to-dmap cset dbound)
|
||||||
|
(cset? symbol? . -> . cset?)
|
||||||
|
(mover cset dbound null
|
||||||
|
(λ (cmap dmap)
|
||||||
|
(make-dcon-dotted
|
||||||
|
null
|
||||||
|
(hash-ref cmap dbound
|
||||||
|
(λ () (int-err "No constraint for bound ~a" dbound)))
|
||||||
|
dbound))))
|
||||||
|
|
||||||
;; This one's weird, because the way we set it up, the rest is already in the dmap.
|
;; This one's weird, because the way we set it up, the rest is already in the dmap.
|
||||||
;; This is because we create all the vars, then recall cgen/arr with the new vars
|
;; This is because we create all the vars, then recall cgen/arr with the new vars
|
||||||
;; in place, and the "simple" case will then call move-rest-to-dmap. This means
|
;; in place, and the "simple" case will then call move-rest-to-dmap. This means
|
||||||
|
@ -186,13 +199,22 @@
|
||||||
(cset-meet*
|
(cset-meet*
|
||||||
(list arg-mapping darg-mapping ret-mapping)))]
|
(list arg-mapping darg-mapping ret-mapping)))]
|
||||||
;; bounds are different
|
;; bounds are different
|
||||||
[((arr: ss s #f (cons s-dty dbound) '())
|
[((arr: ss s #f (cons s-dty (? (λ (db) (memq db Y)) dbound)) '())
|
||||||
(arr: ts t #f (cons t-dty dbound*) '()))
|
(arr: ts t #f (cons t-dty dbound*) '()))
|
||||||
(unless (= (length ss) (length ts))
|
(unless (= (length ss) (length ts)) (fail! ss ts))
|
||||||
(fail! ss ts))
|
(when (memq dbound* Y) (fail! s-arr t-arr))
|
||||||
(let* ([arg-mapping (cgen/list V X Y ts ss)]
|
(let* ([arg-mapping (cgen/list V X Y ts ss)]
|
||||||
;; just add dbound as something that can be constrained
|
;; just add dbound as something that can be constrained
|
||||||
[darg-mapping (cgen V (cons dbound X) Y t-dty s-dty)]
|
[darg-mapping (move-dotted-rest-to-dmap (cgen V (cons dbound X) Y t-dty s-dty) dbound)]
|
||||||
|
[ret-mapping (cg s t)])
|
||||||
|
(cset-meet*
|
||||||
|
(list arg-mapping darg-mapping ret-mapping)))]
|
||||||
|
[((arr: ss s #f (cons s-dty dbound) '())
|
||||||
|
(arr: ts t #f (cons t-dty (? (λ (db) (memq db Y)) dbound*)) '()))
|
||||||
|
(unless (= (length ss) (length ts)) (fail! ss ts))
|
||||||
|
(let* ([arg-mapping (cgen/list V X Y ts ss)]
|
||||||
|
;; just add dbound as something that can be constrained
|
||||||
|
[darg-mapping (move-dotted-rest-to-dmap (cgen V (cons dbound* X) Y t-dty s-dty) dbound*)]
|
||||||
[ret-mapping (cg s t)])
|
[ret-mapping (cg s t)])
|
||||||
(cset-meet*
|
(cset-meet*
|
||||||
(list arg-mapping darg-mapping ret-mapping)))]
|
(list arg-mapping darg-mapping ret-mapping)))]
|
||||||
|
@ -354,6 +376,13 @@
|
||||||
[((ListDots: s-dty dbound) (ListDots: t-dty dbound))
|
[((ListDots: s-dty dbound) (ListDots: t-dty dbound))
|
||||||
(when (memq dbound Y) (fail! S T))
|
(when (memq dbound Y) (fail! S T))
|
||||||
(cgen V X Y s-dty t-dty)]
|
(cgen V X Y s-dty t-dty)]
|
||||||
|
[((ListDots: s-dty (? (λ (db) (memq db Y)) s-dbound)) (ListDots: t-dty t-dbound))
|
||||||
|
;; What should we do if both are in Y?
|
||||||
|
(when (memq t-dbound Y) (fail! S T))
|
||||||
|
(move-dotted-rest-to-dmap (cgen V (cons s-dbound X) Y s-dty t-dty) s-dbound)]
|
||||||
|
[((ListDots: s-dty s-dbound) (ListDots: t-dty (? (λ (db) (memq db Y)) t-dbound)))
|
||||||
|
;; s-dbound can't be in Y, due to previous rule
|
||||||
|
(move-dotted-rest-to-dmap (cgen V (cons t-dbound X) Y s-dty t-dty) t-dbound)]
|
||||||
|
|
||||||
;; this constrains `dbound' to be |ts| - |ss|
|
;; this constrains `dbound' to be |ts| - |ss|
|
||||||
[((ListDots: s-dty dbound) (List: ts))
|
[((ListDots: s-dty dbound) (List: ts))
|
||||||
|
@ -408,6 +437,17 @@
|
||||||
[((ValuesDots: ss s-dty dbound) (ValuesDots: ts t-dty dbound))
|
[((ValuesDots: ss s-dty dbound) (ValuesDots: ts t-dty dbound))
|
||||||
(when (memq dbound Y) (fail! ss ts))
|
(when (memq dbound Y) (fail! ss ts))
|
||||||
(cgen/list V X Y (cons s-dty ss) (cons t-dty ts))]
|
(cgen/list V X Y (cons s-dty ss) (cons t-dty ts))]
|
||||||
|
[((ValuesDots: ss s-dty (? (λ (db) (memq db Y)) s-dbound)) (ValuesDots: ts t-dty t-dbound))
|
||||||
|
;; What should we do if both are in Y?
|
||||||
|
(when (memq t-dbound Y) (fail! S T))
|
||||||
|
(cset-meet
|
||||||
|
(cgen/list V X Y ss ts)
|
||||||
|
(move-dotted-rest-to-dmap (cgen V (cons s-dbound X) Y s-dty t-dty) s-dbound))]
|
||||||
|
[((ValuesDots: ss s-dty s-dbound) (ValuesDots: ts t-dty (? (λ (db) (memq db Y)) t-dbound)))
|
||||||
|
;; s-dbound can't be in Y, due to previous rule
|
||||||
|
(cset-meet
|
||||||
|
(cgen/list V X Y ss ts)
|
||||||
|
(move-dotted-rest-to-dmap (cgen V (cons t-dbound X) Y s-dty t-dty) t-dbound))]
|
||||||
;; vectors are invariant - generate constraints *both* ways
|
;; vectors are invariant - generate constraints *both* ways
|
||||||
[((Vector: e) (Vector: e*))
|
[((Vector: e) (Vector: e*))
|
||||||
(cset-meet (cg e e*) (cg e* e))]
|
(cset-meet (cg e e*) (cg e* e))]
|
||||||
|
|
|
@ -147,6 +147,8 @@
|
||||||
(substitute-dots imgs #f v t)]
|
(substitute-dots imgs #f v t)]
|
||||||
[(i-subst/starred imgs rest)
|
[(i-subst/starred imgs rest)
|
||||||
(substitute-dots imgs rest v t)]
|
(substitute-dots imgs rest v t)]
|
||||||
|
[(i-subst/dotted null dty dbound)
|
||||||
|
(substitute-dotted dty dbound v t)]
|
||||||
[(i-subst/dotted imgs dty dbound)
|
[(i-subst/dotted imgs dty dbound)
|
||||||
(int-err "i-subst/dotted nyi")
|
(int-err "i-subst/dotted nyi")
|
||||||
#;
|
#;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user