;; only add the docstring first time around
;; remap impc:ir:add-poly
(define impc:ti:register-new-polyfunc
(lambda (polyfunc-name func-name func-type docstring)
;; check arg types
(if (not (and (or (string? polyfunc-name) (begin (println 'bad 'polyfunc-name: polyfunc-name) #f))
(or (string? func-name) (begin (println 'bad 'polyfunc-name: func-name) #f))
(or (list? func-type) (begin (println 'bad 'type: func-type) #f))
(or (string? docstring) (begin (println 'bad 'docstring: docstring)))))
(impc:compiler:print-compiler-error "couldn't register new polymorphic function")
(let ((candidates (assoc-strcmp polyfunc-name *impc:ti:polyfunc-cache*)))
;; add the bind-poly form to the AOT-header if we're precompiling
(if candidates
(let ((res (cl:find-if (lambda (x) (string=? (vector-ref x 0) func-name))
(vector-ref (cdr candidates) 0))))
;; update the docstring
(if (not (string=? docstring ""))
(begin
(vector-set! (cdr candidates) 1 docstring)
(print-with-colors 'yellow 'default #t (print "Warning:"))
(print " the docstring for the polymorphic function ")
(print-with-colors *impc:compiler:pretty-print-name-color* 'default #t (print func-name))
(print " has been updated.\n")))
(if res
;; if we're overriding an already poly'd function
(vector-set! res 1 func-type)
;; if we're adding a new poly'd function
(vector-set! (cdr candidates) 0
(cons (vector func-name func-type)
(vector-ref (cdr candidates) 0)))))
;; or create a new entry
(set! *impc:ti:polyfunc-cache*
(cons (cons polyfunc-name (vector (list (vector func-name func-type)) docstring))
*impc:ti:polyfunc-cache*)))
(impc:aot:insert-polyfunc-binding-details polyfunc-name func-name docstring)))))