(define impc:ti:spec-new-type?
(lambda (x)
;; (println 'newspec? x)
(if (and (string? x)
(regex:match? x "_poly_")
(not (impc:ti:namedtype-exists? x)))
(let* ((p (regex:split x "_poly_"))
(basename (substring (impc:ir:get-base-type x) 1
(string-length (impc:ir:get-base-type x))))
(name (substring (car p) 1 (string-length (car p))))
(ptrd (impc:ir:get-ptr-depth (cadr p)))
(t1 (cname-decode (impc:ir:get-base-type (cadr p))))
(t2 (impc:ir:get-pretty-tuple-arg-strings t1))
;; (gt (impc:ti:get-generictype-candidate-types name))
(t3 (impc:ti:maximize-generic-type
(apply string-append name "{" (substring t1 1 (- (string-length t1) 1)) "}"
(make-list ptrd "*"))))
(t3b (impc:ir:get-pretty-tuple-arg-strings (cadr (impc:ti:split-namedtype t3))))
(t3c (cons 14 (map (lambda (x)
(if (string? (impc:ir:get-type-from-pretty-str x))
(impc:ir:get-type-from-pretty-str x)
(if (regex:match? x (string-append "^" name "\\**"))
(impc:ir:pointer++ (string-append "%" basename)
(impc:ir:get-ptr-depth x))
(impc:ir:get-type-from-pretty-str x))))
t3b)))
(t3d (impc:ir:get-type-str t3c)))
;; (println 'newspec name basename t3c t3d)
;; (println 'compile:
(if (llvm:compile-ir (string-append "%" basename " = type " t3d))
(begin
(impc:ti:register-new-polytype name
basename
t3c
"")
#t)
#f))
#f)))