;; only add the docstring first time around
;; remap impc:ir:add-polytype
(define impc:ti:register-new-polytype
(lambda (polytype-name type-name type docstring)
;; (println 'newpolytype: polytype-name type-name type)
;; check arg types
(if (not (and (or (string? polytype-name) (begin (println 'bad 'polytype-name: polytype-name) #f))
(or (string? type-name) (begin (println 'bad 'polytype-name: type-name) #f))
(or (list? type) (begin (println 'bad 'type: type) #f))
(or (string? docstring) (begin (println 'bad 'docstring: docstring)))))
(impc:compiler:print-compiler-error "couldn't register new polymorphic type")
(let ((candidates (assoc-strcmp polytype-name *impc:ti:polytype-cache*)))
(if candidates
(let ((res (cl:find-if (lambda (x) (string=? (vector-ref x 0) type-name))
(vector-ref (cdr candidates) 0))))
(if res
;; if we're overriding an already poly'd type
(vector-set! res 1 type)
;; if we're adding a new poly'd type
(vector-set! (cdr candidates) 0
(cons (vector type-name type)
(vector-ref (cdr candidates) 0)))))
;; or create a new entry
(set! *impc:ti:polytype-cache*
(cons (cons polytype-name (vector (list (vector type-name type)) docstring))
*impc:ti:polytype-cache*)))
(if (not (impc:ti:namedtype-exists? type-name))
(impc:ti:register-new-namedtype type-name type docstring))))))