(define impc:ti:handle-forced-types
(lambda (t1 . args)
(if (null? args) '()
(let* ((forced-types (map (lambda (t)
(map (lambda (tt)
;; (println 'tt: tt)
(if (not (or (symbol? tt)
(list? tt)))
(impc:compiler:print-bad-type-error t "bad fixed type")))
(if (list? t) (cdr t) (list (cdr t))))
(cons (car t) (impc:ir:convert-from-pretty-types (cdr t))))
args))
;; (llllll (println 'ft forced-types))
(forced-types-updated (apply append (list)
(map (lambda (t)
;; first off we might be introducing a new spec'd type here!
(if (string? (cdr t))
(impc:ti:spec-new-type? (cdr t)))
;; on with the show!
(if (and (impc:ir:closure? (cdr t))
(not (null? (impc:ti:get-closure-arg-symbols (car t) t1))))
(if (<> (length (cdddr t))
(length (impc:ti:get-closure-arg-symbols (car t) t1)))
(impc:compiler:print-bad-type-error (cdr t) (car t))
(append (map (lambda (sym type)
(cons sym type))
(impc:ti:get-closure-arg-symbols (car t) t1)
(cdddr t))
(list t)))
(list t)))
forced-types)))
;; (lllllllllllll (println 'typesupdated forced-types-updated))
(checked-for-duplicates (let loop ((types forced-types-updated))
(if (null? types) (cl:remove-duplicates forced-types-updated)
(if (and (assoc-strcmp (caar types) (cdr types))
(not (equal? (cdr (assoc-strcmp (caar types) (cdr types)))
(cdr (car types)))))
(impc:compiler:print-type-mismatch-error
(cdar types)
(cdr (assoc-strcmp (caar types) (cdr types)))
(caar types))
(loop (cdr types))))))
(fullyqualified (cl:remove-if-not (lambda (t) (impc:ir:type? (cdr t))) checked-for-duplicates)))
;; return fully qualified types
fullyqualified))))