;;; This type checks a variable. Possible cases:
;;; a) recursive variables
;;; b) method variables
;;; c) generalized variables
;;; d) other variables
(define-type-checker var-ref
(let* ((var (var-ref-var object))
(type (var-type var)))
(cond ((method-var? var)
;;; The context of a method variable always has the carrier class
;;; first.
(mlet (((ntype new-tyvars) (instantiate-gtype/newvars type))
(carrier-tyvar (car new-tyvars))
(extra-context (cdr new-tyvars))
(p (**method-placeholder
var carrier-tyvar (dynamic *enclosing-decls*) object))
(new-object (insert-dict-placeholders p extra-context object)))
(remember-placeholder p)
(return-type (**save-old-exp object new-object) ntype)))
((recursive-type? type)
(let ((placeholder (**recursive-placeholder
var (dynamic *enclosing-decls*))))
(push placeholder (recursive-type-placeholders type))
(return-type placeholder (recursive-type-type type))))
((gtype? type)
(mlet (((ntype new-vars) (instantiate-gtype/newvars type))
(object1 (insert-dict-placeholders object new-vars object)))
(return-type (if (eq? object1 object)
object
(**save-old-exp object object1))
ntype)))
(else
(return-type object type)))))
;;; This takes an expression and a context and returns an updated
;;; expression containing placeholders for the context information
;;; implied by the context. Tyvars in the context are added to dict-vars.
(define (insert-dict-placeholders object tyvars var)
(cond ((null? tyvars)
object)
((null? (ntyvar-context (car tyvars)))
(insert-dict-placeholders object (cdr tyvars) var))
(else
(let ((tyvar (car tyvars)))
(insert-dict-placeholders
(insert-dict-placeholders/tyvar
tyvar (ntyvar-context tyvar) object var)
(cdr tyvars)
var)))))
(define (insert-dict-placeholders/tyvar tyvar classes object var)
(if (null? classes)
object
(let ((p (**dict-placeholder
(car classes) tyvar (dynamic *enclosing-decls*) var)))
(remember-placeholder p)
(insert-dict-placeholders/tyvar tyvar (cdr classes)
(**app object p) var))))
|