impc:ti:register-new-polytype   scheme

Defined in:


;; 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))
          (if (not (impc:ti:namedtype-exists? type-name))
              (impc:ti:register-new-namedtype type-name type docstring))))))

Back to Index