;; force specializations on a generic funtion
(define impc:ti:specialize-genericfunc
(lambda (sym . types)
;; (println 'impc:ti:specialize-genericfunc 'sym: sym types)
(if (not (impc:ti:genericfunc-exists? (string->symbol sym)))
(impc:compiler:print-missing-identifier-error sym "generic function")
(let ((printspec *impc:ti:print-code-specialization-compiles*))
(set! *impc:ti:print-code-specialization-compiles* #t)
(for-each
(lambda (t)
(if (regex:match? t "_poly_")
(set! t (cname-decode (cadr (regex:type-split t "_poly_")))))
(let ((etype (cname-encode t)))
(if (not (impc:ti:closure-exists? (string-append sym "_poly_" etype)))
(let* ((arity (impc:ir:get-arity-from-pretty-closure t))
(gftypes (impc:ti:genericfunc-types (string->symbol sym) arity t))
(res (if (not gftypes)
(impc:compiler:print-compiler-error "Bad generic closure type:" (list sym t))))
(code (caddr (cadr gftypes)))
(pfunc (string->symbol (string-append sym "_poly_" etype))))
;; (println 'makesym etype 't: t)
;; (println 'arity: arity 'code: code 'pfunc: pfunc)
;; pre-populate the closure cache for the new specialised func
(if (not (impc:ti:closure-exists? (symbol->string pfunc)))
(impc:ti:register-new-closure (symbol->string pfunc)
'()
*impc:default-zone-size*
""
code))
(set! code `(let ((,pfunc ,code)) ,pfunc))
(impc:ti:run pfunc code *impc:default-zone-size* #f #f (cons pfunc (string->symbol t)))
(impc:ti:register-new-polyfunc sym
(symbol->string pfunc)
(impc:ir:get-type-from-pretty-str t)
"")
(impc:ti:initialize-closure-with-new-zone (symbol->string pfunc)
*impc:default-zone-size*)
pfunc))))
types)
(set! *impc:ti:print-code-specialization-compiles* printspec)
#t))))