impc:ti:callback-check   scheme

(define impc:ti:callback-check
  (lambda (ast vars kts request?)
    (let* ((cbType (impc:ti:type-check (caddr ast) vars kts '()))
           (ftypeA (map impc:ir:get-type-from-str
                      (let ((ags (impc:ti:get-closure-arg-types (symbol->string (caddr ast)))))
                        (if ags ags '()))))
           (ftype (if (null? ftypeA) cbType (cons 213 ftypeA))))
      (if *impc:ti:print-sub-checks* (println 'ftype:> 'ast: ast 'type: ftype))
      (impc:ti:type-check (cadr ast) vars kts *impc:ir:si64*)
      (if (null? ftype)
          (begin (let ((fargs (cons 213
                                    (cons -1
                                          (map (lambda (a)
                                                 (impc:ti:type-check a vars kts '()))
                                               (cdddr ast))))))
                   (if (and (impc:ir:type? fargs)
                            (assoc (caddr ast) vars)
                            (null? (cdr (assoc (caddr ast) vars))))
                       (impc:ti:update-var  (caddr ast) vars kts fargs)))
                 (list *impc:ir:void*))
          (begin (if (<> (+ 2 (length ftype))
                         (length ast))
                     (impc:compiler:print-compiler-error "bad arity in call" ast))
                 (if (and (assoc (caddr ast) vars)
                          (null? (cdr (assoc (caddr ast) vars))))
                     (impc:ti:update-var (caddr ast) vars kts ftype))
                 ;; we don't care what we get back
                 (for-each (lambda (a t)
                             (if (symbol? a) (impc:ti:update-var a vars kts t))
                             (impc:ti:type-check a vars kts t))
                           (cdddr ast)
                           (cdr ftype))
                 ;; callback returns void
                 (list *impc:ir:void*))))))