blob: 4091ce4456bb58a9abdb74643fa24b8721ab392e (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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))))
|