impc:ti:fptrcall-check   scheme

;; for fptrcall
;; which has the form
;; (fptrcall fptr ... args)
(define impc:ti:fptrcall-check
  (lambda (ast vars kts request?)
    ;; (println 'ast: ast)
    (let* ((fptr (impc:ti:type-check (cadr ast) vars kts #f))
           ;; (lllll (println 'fptr fptr))
           (ctype (if (impc:ir:closure? (car fptr))
                      (car fptr)
                      (impc:compiler:print-bad-type-error (car fptr) "bad fptr type in fptrcall")))
           ;; (lllllll (println 'ctype ctype))
           ;; get argument expression types
           (res (map (lambda (e t)
                       ;;(println 'e: e 't: t)
                       (let ((res (impc:ti:type-check e vars kts
                                                      (if (symbol? t)
                                                          (impc:ti:symbol-check t vars kts #f)
                                                          t))))
                         ;; if t is a symbol then add res to t
                         (if (symbol? t)
                             (if (or (and (list? res)
                                          (impc:ir:type? (car res)))
                                     (impc:ir:type? res))
                                 (impc:ti:force-var t vars kts res)
                                 (impc:ti:update-var t vars kts res)))
                         res))
                     (cddr ast)
                     (if (<> (length (cddr ctype))
                             (length (cddr ast)))
                         (impc:compiler:print-bad-arity-error ast)
                         (cddr ctype)))))
      (cadr ctype))))