;; don't allow update to add to kts values
(define impc:ti:update-var
(lambda (sym vars kts t)
;; clean type
;; i.e. change (211 4 (0) (1) 0)) -> (211 4 0 1 0)
;;
(if (and (list? t)
(= (length t) 1)
(or (string? (car t))
(impc:ir:type? (car t))))
(set! t (car t)))
(set! t (impc:ti:type-clean t))
;; (println sym 'b1: t)
(set! t (impc:ti:type-normalize t vars))
;; (println 'xym sym t (member sym vars) (member sym kts))
;; (println sym 'b2: t)
;; (if (and (string? t)
;; #t
;; (assoc-strcmp sym vars))
;; (let* ((p (assoc-strcmp sym vars))
;; (l (map (lambda (k) (string? k)) (cdr p))))
;; (println 'p p 'l l)
;; (if (and (member #t l)
;; (not (member t (cdr p))))
;; (begin
;; (if (regex:match? t "^%")
;; (impc:compiler:print-type-mismatch-error (impc:ir:pretty-print-type (impc:ti:get-named-type t)) p)
;; (impc:compiler:print-type-mismatch-error t p))))))
;; don't ever add oursevles (i.e. sym) as a type arg or NULL
(if (or (null? t)
(equal? t #f)
(and (list? t)
(equal? sym (car t)))
(impc:ti:nativefunc-exists? (symbol->string sym)) ;; native funcs already have a type
(equal? sym t))
'exit
(begin ;; (println 'update-var:> sym 'in: vars 'with: t 'kts: kts)
(if (member sym kts) ;; if in known types don't do anything
'()
(if (and (not (assoc-strcmp sym vars))
(not (regex:match? (symbol->string sym) ":\\["))
(not (impc:ti:closure-exists? (symbol->string sym)))
(not (impc:ti:globalvar-exists? (symbol->string sym))))
(begin ;; sometimes generic types don't spec all
;; their !'s - weshould carry on anyway!
;; (println 'sym sym)
;;(if (not (regex:match? (symbol->string sym) "^!"))
(if (not (regex:match? (symbol->string sym) "!"))
(impc:compiler:print-missing-identifier-error sym 'type))
'exit)
(let ((pair (assoc-strcmp sym vars)))
(if pair
(let ((pair-rest (cdr pair)))
(if (or (impc:ir:type? t)
(impc:ti:complex-type? t))
(begin
;; if 't' is a closure without a return type
;; but has new argument types then we might be able
;; to infer the return type from the arg types
(if (and (impc:ir:closure? t)
(not (impc:ir:type? t)))
(begin
(let ((res (impc:ti:type-check-bound-lambda sym vars kts t)))
(if res
(set-car! (cdr t) res)))))
;; uncomment the following lines to do reverse bang tests
(if (and (string? t) ;; if a named type
(string-contains? (symbol->string sym) "##"))
(let ((gtd (impc:ti:generic-type-details sym)))
(impc:ti:reverse-set-bangs-from-reified sym t (cadr gtd) vars)))
(if (and
#f
(string? t)
(impc:ir:tuple? pair-rest))
(set-cdr! pair (list t))
(set-cdr! pair (cl:remove-duplicates (append (list t) pair-rest))))
)
;(set-cdr! pair (cl:remove-if-not
; (lambda (x) (impc:ir:type? x))
; (cl:remove-duplicates
; (append t pair-rest))))))
(set-cdr! pair (cl:remove-duplicates (append t pair-rest))))))
'())))))))