;; this attempts to update-var !bangs from reified types and also GTypes
;; i.e. if we have allready resolved xlist*##289 to %xlist--2812497382948
;; but we have failed to resolve !head##289
;; then we try to get back from %xlist--2812497382948 to set !head##289
(define impc:ti:reverse-set-bangs-from-reified
(lambda (poly reified gnum vars)
;; (println 'reverse-bangs: poly 'gnum: gnum)
;; (println 'vars vars)
;; (println 'reified: reified)
;; (println 'pretty: (impc:ir:pretty-print-type reified))
;; (println 'okpretty)
(if (and (not (list? poly))
(or (not (symbol? poly))
(not (regex:match? (symbol->string poly) "(:|{)"))))
'done ;; we can only check reified if poly IS a list (not a reference to a list!)
(let* ((prettyreified (impc:ir:pretty-print-type reified))
(sss (if (list? poly) "" (car (regex:type-split (symbol->string poly) "##"))))
;; (gpolytype (if (list? poly) poly (impc:ir:get-type-from-pretty-str sss)))
(namedtype (impc:ir:get-type-from-str (impc:ti:get-named-type reified)))
(gpolytype (if (list? poly) poly
(cons (car namedtype) (impc:ir:get-type-from-pretty-tuple
(cadr (impc:ti:split-namedtype (impc:ti:maximize-generic-type sss))))))))
;; (println 'poly: poly 'gnum gnum)
;; (println 'reified: (impc:ti:get-named-type reified))
;; (println 'polyt: gpolytype)
;; (println 'named: namedtype)
(if (<> (length gpolytype)
(length namedtype))
;; (impc:compiler:print-type-mismatch-error (list poly
;; gpolytype) (list reified namedtype)))
'()
(for-each (lambda (a b)
;; (println 'a: a 'b: b)
(if (symbol? b)
(if (regex:match? (symbol->string b) "^!")
(impc:ti:update-var
(string->symbol (string-append (symbol->string b) "##" (number->string gnum)))
vars '() a)))
(if (and (string? a)
(not (string=? a reified)) ;; watch out for recursive!
(string-contains? a "_poly_"))
(impc:ti:reverse-set-bangs-from-reified b a gnum vars)))
namedtype gpolytype))))))