diff options
author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
---|---|---|
committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /type/type-vars.scm |
Import to github.
Diffstat (limited to 'type/type-vars.scm')
-rw-r--r-- | type/type-vars.scm | 60 |
1 files changed, 60 insertions, 0 deletions
diff --git a/type/type-vars.scm b/type/type-vars.scm new file mode 100644 index 0000000..4091ce4 --- /dev/null +++ b/type/type-vars.scm @@ -0,0 +1,60 @@ +;;; 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)))) |