summaryrefslogtreecommitdiff
path: root/type/type-vars.scm
diff options
context:
space:
mode:
Diffstat (limited to 'type/type-vars.scm')
-rw-r--r--type/type-vars.scm60
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))))