(define make_static_scheme_wrapper_ir
(lambda (symname-string closure-type)
(let* ((stub-type (impc:ir:get-closure-type-from-str closure-type))
(scheme-stub-valid? #t)
(closure-type-- (impc:ir:get-type-str (impc:ir:pointer-- (impc:ir:get-type-from-str closure-type))))
(ir (string-append "define dllexport ccc i8* "
" @" (string-append symname-string "_scheme(i8* %_sc, i8* %args) nounwind\n"
"{\nentry:\n"
(apply string-append
(map (lambda (t n idx)
(string-append n "_val = call ccc i8* @list_ref(i8* %_sc, i32 " (number->string idx) ",i8* %args)\n"
(cond ((and (not (number? t))
(not (impc:ir:pointer? t)))
(set! scheme-stub-valid? #f)
"")
((or (not (number? t))
(not (or (impc:ir:number? t)
(impc:ir:void? t))))
(if (and (number? t)
(= t (+ *impc:ir:pointer* *impc:ir:si8*)))
(string-append n "_rt_check = call i32 @is_cptr_or_str(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i8* @cptr_value(i8* " n "_val)\n")
(string-append n "_rt_check = call i32 @is_cptr(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
"%ttv_" (number->string idx) " = call ccc i8* @cptr_value(i8* " n "_val)\n"
n " = bitcast i8* %ttv_" (number->string idx) " to " (impc:ir:get-type-str t) "\n")))
((= t *impc:ir:fp64*) (string-append n "_rt_check = call i32 @is_real(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc double @r64value(i8* " n "_val)\n"))
((= t *impc:ir:fp32*) (string-append n "_rt_check = call i32 @is_real(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc float @r32value(i8* " n "_val)\n"))
((= t *impc:ir:si64*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i64 @i64value(i8* " n "_val)\n"))
((= t *impc:ir:ui64*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i64 @i64value(i8* " n "_val)\n"))
((= t *impc:ir:si32*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i32 @i32value(i8* " n "_val)\n"))
((= t *impc:ir:ui32*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i32 @i32value(i8* " n "_val)\n"))
((= t *impc:ir:si16*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i16 @i16value(i8* " n "_val)\n"))
((= t *impc:ir:ui16*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i16 @i16value(i8* " n "_val)\n"))
((= t *impc:ir:si8*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i8 @i8value(i8* " n "_val)\n"))
((= t *impc:ir:ui8*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i8 @i8value(i8* " n "_val)\n"))
((= t *impc:ir:i1*) (string-append n "_rt_check = call i32 @is_integer(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i1 @i1value(i8* " n "_val)\n"))
((= t *impc:ir:char*) (string-append n "_rt_check = call i32 @is_string(i8* " n "_val)\n"
(impc:ti:scm_rt_check_string n symname-string)
n " = call ccc i8* @string_value(i8* " n "_val)\n"))
(else (impc:compiler:print-compiler-error "bad type in scheme stub")))))
(cdr stub-type)
(make-list-with-proc (length (cdr stub-type))
(lambda (i) (string-append "%arg_" (atom->string i))))
(make-list-with-proc (length (cdr stub-type)) (lambda (i) i))))
(if (impc:ir:void? (car stub-type)) "" "%result = ")
"call ccc " (impc:ir:get-type-str (car stub-type)) " @" symname-string "(" ;; " %ff("