(define impc:ti:run
(lambda (symname code zone-size poly static . args)
;; (println '-----------> 'impc:ti:run: symname 'poly: poly 'static: static)
;; (println 'code: code)
;; (println 'args: args)
(set! *impc:ir:sym-name-stack* '())
(set! *impc:ir:ls_var* '())
(set! *impc:ti:bound-lambdas* '())
(set! *impc:ti:generic-type-mappings* '())
(set! *impc:ti:nativef-generics-recurse-test* 0)
;; adhoc
(set! *impc:ti:adhoc-cnt* (+ *impc:ti:adhoc-cnt* 1))
(define adhoc-poly-name symname)
(define adhoc-poly-name-string (symbol->string symname))
(if (and poly ;*impc:ti:implicit-adhoc-compiles*
(not (regex:match? adhoc-poly-name-string "(_poly_|_adhoc_)")))
(begin
(set! symname (string->symbol (string-append adhoc-poly-name-string
"_adhoc_"
(number->string *impc:ti:adhoc-cnt*))))
(if (not (null? args))
(set! args (replace-all args (list (cons adhoc-poly-name symname)))))
(set! code (replace-all code (list (cons adhoc-poly-name symname))))))
;; don't want type checking to find existing native versions!
(if (and *impc:compile* (not static))
(begin
(llvm:erase-function (string-append (symbol->string symname) "_setter"))
(llvm:erase-function (string-append (symbol->string symname) "_maker"))))
(let* ((symname-string (symbol->string symname))
(oldsymname-string symname-string)
;(c code)
(shadows (impc:ti:rename-all-shadow-vars symname code '()))
(c1 (impc:ti:get-var-types shadows)) ;; this is a cons pairof (ast . types)
(ta (impc:ti:first-transform (car c1) #t)) ;; car is ast
;; might be over kill doing shadow vars twice!
(shadow-code (impc:ti:rename-all-shadow-vars symname ta '()))
(c2 (impc:ti:get-var-types shadow-code)) ;; it is possible for macros in the first-transform to introduce new var-types
(ccc (append (cdr c2) (cdr c1)))
(cc (impc:ti:expand-generic-types ccc))
(t1 (car c2))
(t2 (impc:ti:mark-returns t1 symname #f #f #f))
(t3 (impc:ti:closure:convert t2 (list symname)))
(vars (map (lambda (x) (list x)) (impc:ti:find-all-vars t3 '())))
;; (llllllllll (begin (println 'vars: vars) (error)))
(forced-types (apply impc:ti:handle-forced-types t1 (append cc args)))
(t4 (impc:ti:coercion-run t2 forced-types)) ;; t4 and t5 are optional
(typespre (impc:ti:run-type-check vars forced-types t4))
(t5 (impc:ti:closure:convert t4 (list symname)))
(types (impc:ti:type-normalize typespre))
(newast '()))
;; (println 'forced: forced-types)
;; (println 'types-post: types)
;; (println 'run: (impc:ti:unity? types))
;; (println 'newast: newast)
;; (println 'forced: forced-types)
;; (println 'times: (- ct2 ct1) (- ct3 ct2) (- ct4 ct3) (- ct5 ct4) (- ct6 ct5) (- ct7 ct6) (- ct8 ct7) (- ct9 ct8) (- ct10 ct9) (- ct11 ct10))