impc:ti:register-new-polyfunc   scheme

Defined in:


;; 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 ""))
                      (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:aot:insert-polyfunc-binding-details polyfunc-name func-name docstring)))))

Back to Index