impc:ir:compile:apply-closure   scheme

(define impc:ir:compile:apply-closure
  (lambda (ast types ftype-provided? . args)
    ;; (println 'apply-closure ast 'ts: types 'symstack: *impc:ir:sym-name-stack*)
    ;; (if ftype-provided? (println 'ftype: (car args)))
    (let* ((functiontype (if ftype-provided?
                             (cdr (impc:ir:get-type-from-str (cadar (car args))))
                             (if (and (assoc-strcmp (car ast) types)
                                      (impc:ir:closure? (cdr (assoc-strcmp (car ast) types)))
                                      (= 2 (impc:ir:get-ptr-depth (cdr (assoc-strcmp (car ast) types)))))
                                 (cddr (assoc-strcmp (car ast) types))
                                 (if (impc:ir:closure? (cdr (assoc-strcmp (car ast) types)))
                                     (impc:compiler:print-bad-type-error (car ast) "remember that closures must be pointers")
                                     (impc:compiler:print-bad-type-error (car ast) "bad type for closure")))))
           ;;(recursive-call (if (eq? (car ast) (car *impc:ir:sym-name-stack*)) #t #f))
           (recursive-call (if (member (car ast) *impc:ir:sym-name-stack*) #t #f))
           (os (make-string 0))
           (ftype (impc:ir:make-function-str functiontype #t))
           (clstype (string-append "{i8*, i8*, " ftype "*}*"))
           (vars (map (lambda (arg hint)
                        (emit (impc:ir:compiler arg types hint) os)
                        (impc:ir:gname))
                      (cdr ast)
                      (cdr functiontype))))
      ;; (println 'recursive-call! recursive-call (car *impc:ir:sym-name-stack*) (car ast))
      (emit "\n; apply closure \n" os)
      (define v '())
      (if ftype-provided?
          (begin (emit (impc:ir:gname "val" clstype)
                       " = load " clstype "," clstype "* " (caar (car args)) "\n" os)
                 (set! v (car (impc:ir:gname "val"))))
          (begin (emit (impc:ir:gname "vval" (string-append clstype "*"))
                       " = load " clstype "*, " clstype "** %"
                       (symbol->string (car ast)) "Ptr\n" os)
                 (emit (impc:ir:gname "val" clstype)
                       " = load " clstype "," clstype "* " (car (impc:ir:gname 1)) "\n" os)
                 (set! v (car (impc:ir:gname "val")))))
      (emit (string-append (impc:ir:gname "fPtr" clstype)
                           " = getelementptr " (impc:ir:pointer-- clstype) ", " clstype " " v ", i32 0, i32 2\n") os)
      (emit (string-append (impc:ir:gname "ePtr" clstype) " = getelementptr "
                           (impc:ir:pointer-- clstype) ", " clstype " " v ", i32 0, i32 1\n") os)
      (emit (string-append (impc:ir:gname "f" (string-append ftype "*"))
                           " = load " ftype "*, " ftype "** " (car (impc:ir:gname "fPtr")) "\n") os)
      (emit (string-append (impc:ir:gname "e" "i8*")
                           " = load i8*, i8** " (car (impc:ir:gname "ePtr")) "\n") os)