(define impc:ti:nativef-generics-check-return-type
(lambda (ast lambda-code gpoly-type gnum vars args req?)
;; (println 'lambda-code: lambda-code 'gnum: gnum)
;; (println 'check-ret-type: gpoly-type 'request? req?)
;; (println 'rec: ast *impc:ti:nativef-generics-recurse-test*)
(let ((grtype '()))
;;
;; this section is here to check for a return type
;; for this generic function.
;; we do this by grabbing the gpoly's lambda code and
;; sending it through type checking.
;;
(if (< *impc:ti:nativef-generics-recurse-test* 5)
(begin
(set! *impc:ti:nativef-generics-recurse-test*
(+ *impc:ti:nativef-generics-recurse-test* 1))
;; type inferencing for generic functions return argument!
(let* ((symname 'placeholder)
(extantsyms (map (lambda (x) (car x)) vars))
(s1 (impc:ti:rename-all-shadow-vars symname lambda-code extantsyms))
(c1 (impc:ti:get-var-types s1))
(t1 (impc:ti:first-transform (car c1) #t))
(s2 (impc:ti:rename-all-shadow-vars symname t1 extantsyms))
(c2 (impc:ti:get-var-types s2)) ;;lambda-code))
(t2 (impc:ti:mark-returns (car c2) symname #f #f #f))
(t3 (impc:ti:closure:convert t2 (list symname)))
(lvars (map (lambda (x) (list x)) (impc:ti:find-all-vars t3 '())))
(lvarnames (map (lambda (x) (car x)) lvars))
(tr1 (impc:ti:type-unify gpoly-type vars))
(trequest (if req? req? tr1))
(kts (cl:remove #f (map (lambda (x y) (if (impc:ir:type? y) x #f)) (cadr s1) args)))
(newvars (append lvars vars))
(ttype '()))
;; this here as a check (could be removed)
(if (not (null? (cl:intersection lvarnames extantsyms)))
(impc:compiler:print-compiler-error "shadow vars found when specialising generic code" (cl:intersection lvarnames extantsyms)))
;; this is another check (could be removed)
(for-each (lambda (x)
(if (member (car x) lvarnames)
(println 'Type 'Collision 'On x)))
vars)