(define impc:ti:let-check
(lambda (ast vars kts request?)
;; (println 'letchk: ast 'req request?) ; 'vars vars)
;; (println 'vars: vars '(cadr ast) (cadr ast))
;; for the symbols we want to set each return type
(let ((internalreq? (cond ((equal? `(begin ,(caar (cadr ast)))
(caddr ast))
request?)
(else #f))))
(for-each (lambda (e)
;; (println 'e e)
(if (and (list? (cadr e))
(equal? (caadr e) 'lambda))
(set! *impc:ti:bound-lambdas* (cons e *impc:ti:bound-lambdas*)))
(if (and #f
(assoc-strcmp (car e) vars)
(impc:ir:type? (impc:ti:type-unify (cdr (assoc-strcmp (car e) vars)) vars)))
(list (impc:ti:type-unify (cdr (assoc-strcmp (car e) vars)) vars))
(let ((a (impc:ti:type-check (cadr e) vars kts
(cond ((assoc-strcmp (car e) kts)
;; (println 'retfor (car e) (cadr (assoc-strcmp (car e) kts)))
(cadr (assoc-strcmp (car e) kts)))
((and (not (null? (cdr (assoc-strcmp (car e) vars))))
(impc:ir:type? (cadr (assoc-strcmp (car e) vars))))
;; (println 'retfor (car e) (cadr (assoc-strcmp (car e) vars)))
(cadr (assoc-strcmp (car e) vars)))
(else
;; (println 'retfor (car e) internalreq?)
internalreq?)))))
;; (println '---update: (car e) 'with: a)
(impc:ti:update-var (car e) vars kts a)
;; (println '---vars: vars)
)))
(cadr ast))
;; then return the return type for the whole let
;; which should have a begin body! so caddr should work
(let ((ret (impc:ti:type-check (caddr ast) vars kts request?)))
ret))))