git.fiddlerwoaroof.com
Raw Blame History
;;; 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))))