(define impc:ti:genericfunc-types
(lambda (name arity type)
;; (println 'name name 'arity arity 'type type)
(let ((arity_check_only (if (equal? type #f) #t #f))
(failed_constraint_check #f))
;; (println 'poly: name 'a: arity 't: type)
(if (symbol? name) (set! name (symbol->string name)))
;; (println 'type_a: type)
(cond ((and type (list? type))
(set! type (impc:ir:genericfunc-type-setup type))
;; if lgth(type) = arity then we only have args
;; and we should add a "_" return type
(if (= (length type) arity)
(set! type (cons "_" type))))
((and type (string? type))
(let ((ags (impc:ir:get-pretty-closure-arg-strings type)))
(set! type (map (lambda (x)
;; (println 'x: x)
(if (or (char=? (string-ref x 0) (integer->char 91))
(char=? (string-ref x 0) (integer->char 60)))
x
(if (regex:match? x "(:|{)")
(apply string-append (car (impc:ti:split-namedtype x))
(make-list (impc:ir:get-ptr-depth x) "*"))
(if (regex:match? x "^\\!")
"_"
x))))
ags))))
(else (set! type (make-list (+ 1 arity) "_"))))
;; (println 'type_b: type)
(let* ((tmp (assoc-strcmp-all (string->symbol name) *impc:ti:genericfunc-cache*))
(res (cl:remove-if (lambda (x)
(or
(not (if (list-ref x 5)
(apply (eval (list-ref x 5))
(map (lambda (x)
(if (string? x)
(if (string=? x "_")
*impc:ir:notype*
(impc:ir:get-type-from-pretty-str x))
*impc:ir:notype*
x))
type))
#t))
(<> arity (cadr x))))
tmp)))
;; (println 'res res 'tmp tmp)
;; if we are searching for 'notype' (i.e. haven't really
;; started looking yet) then we will just return the first
;; thing with the correct arity.
(if (and (null? res)
(member #t (map (lambda (x) (and (string? x) (string=? x "_"))) type)))
(let ((t2 (cl:remove-if (lambda (x) (<> arity (cadr x))) tmp)))
(if (not (null? t2))
(set! res (list (car t2))))))