Fix instantiate and abstract to handle bounds properly.
NEW INVARIANT - only use instantiate w/ names
This commit is contained in:
parent
a7c63840e4
commit
017f756c77
|
@ -5,7 +5,7 @@
|
|||
|
||||
(require "unify.ss" "type-comparison.ss" "type-rep.ss" "effect-rep.ss" "subtype.ss"
|
||||
"planet-requires.ss" "tc-utils.ss" "union.ss"
|
||||
"resolve-type.ss"
|
||||
"resolve-type.ss" "type-utils.ss"
|
||||
"type-effect-convenience.ss"
|
||||
(lib "trace.ss")
|
||||
(lib "plt-match.ss")
|
||||
|
|
|
@ -290,6 +290,17 @@
|
|||
[#:F name* (if (eq? name name*) (*B (+ count outer)) ty)]
|
||||
;; necessary to avoid infinite loops
|
||||
[#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
|
||||
;; functions
|
||||
[#:arr dom rng rest drest thn-eff els-eff
|
||||
(*arr (map sb dom)
|
||||
(sb rng)
|
||||
(if rest (sb rest) #f)
|
||||
(if drest
|
||||
(cons (sb (car drest))
|
||||
(if (eq? (cdr drest) name) (+ count outer) (cdr drest)))
|
||||
#f)
|
||||
(map (lambda (e) (sub-eff sb e)) thn-eff)
|
||||
(map (lambda (e) (sub-eff sb e)) els-eff))]
|
||||
[#:Mu (Scope: body) (*Mu (*Scope (loop (add1 outer) body)))]
|
||||
[#:PolyDots n body*
|
||||
(let ([body (remove-scopes n body*)])
|
||||
|
@ -307,6 +318,7 @@
|
|||
|
||||
;; instantiate-many : List[Type] Scope^n -> Type
|
||||
;; where n is the length of types
|
||||
;; all of the types MUST be Fs
|
||||
(define (instantiate-many images sc)
|
||||
(define (replace image count type)
|
||||
(let loop ([outer 0] [ty type])
|
||||
|
@ -318,6 +330,17 @@
|
|||
ty)]
|
||||
;; necessary to avoid infinite loops
|
||||
[#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
|
||||
;; functions
|
||||
[#:arr dom rng rest drest thn-eff els-eff
|
||||
(*arr (map sb dom)
|
||||
(sb rng)
|
||||
(if rest (sb rest) #f)
|
||||
(if drest
|
||||
(cons (sb (car drest))
|
||||
(if (= (cdr drest) (+ count outer)) (F-n image) (cdr drest)))
|
||||
#f)
|
||||
(map (lambda (e) (sub-eff sb e)) thn-eff)
|
||||
(map (lambda (e) (sub-eff sb e)) els-eff))]
|
||||
[#:Mu (Scope: body) (*Mu (*Scope (loop (add1 outer) body)))]
|
||||
[#:PolyDots n body*
|
||||
(let ([body (remove-scopes n body*)])
|
||||
|
@ -468,13 +491,6 @@
|
|||
(list syms (PolyDots-body* syms t))))
|
||||
(list nps bp)))])))
|
||||
|
||||
;; unfold : Type -> Type
|
||||
;; must be applied to a Mu
|
||||
(define (unfold t)
|
||||
(match t
|
||||
[(Mu: sc) (instantiate t sc)]
|
||||
[_ (int-err "unfold: requires Mu type, got ~a" t)]))
|
||||
|
||||
;; type equality
|
||||
(define type-equal? eq?)
|
||||
|
||||
|
@ -491,7 +507,6 @@
|
|||
;(trace subst subst-all)
|
||||
|
||||
(provide
|
||||
unfold
|
||||
Mu-name: Poly-names:
|
||||
PolyDots-names:
|
||||
Type-seq Effect-seq
|
||||
|
|
|
@ -17,7 +17,8 @@
|
|||
tc-result:
|
||||
tc-result-equal?
|
||||
effects-equal?
|
||||
tc-result-t)
|
||||
tc-result-t
|
||||
unfold)
|
||||
|
||||
|
||||
;; substitute : Type Name Type -> Type
|
||||
|
@ -35,7 +36,12 @@
|
|||
(foldr (lambda (e acc) (substitute (cadr e) (car e) acc)) t s))
|
||||
|
||||
|
||||
|
||||
;; unfold : Type -> Type
|
||||
;; must be applied to a Mu
|
||||
(define (unfold t)
|
||||
(match t
|
||||
[(Mu: name b) (substitute t name b)]
|
||||
[_ (int-err "unfold: requires Mu type, got ~a" t)]))
|
||||
|
||||
(define (instantiate-poly t types)
|
||||
(match t
|
||||
|
|
Loading…
Reference in New Issue
Block a user