impc:ti:lambda-check   scheme

(define impc:ti:lambda-check
  (lambda (ast vars kts request?)
    ;; (println 'lcheck: ast 'request? request?)
    ;; first we check if a type request has been made
    (if (and request? (impc:ir:closure? request?))
        ;; if there is a request then cycle through
        ;; and set lambda arg symbols
        (begin
          (if (<> (length (cadr ast))
                  (length (cddr request?)))
              (begin
                (impc:compiler:print-compiler-error "Bad request to lambda chk:" ast)))
          (map (lambda (sym req)
                 (if (symbol? sym)
                     (if (atom? req)
                         (impc:ti:update-var sym vars kts (list req))
                         (impc:ti:update-var sym vars kts req))))
               (cadr ast)
               (cddr request?))
          ;; finally set request? to the return type
          (set! request? (cadr request?))))
    ;; run body for type coverage
    ;; grab the last result as return type
    (let ((res (impc:ti:type-unify (impc:ti:type-check (caddr ast) vars kts request?) vars)))
      ;; if no valid return type rerun type-check for a second time
      (if (not (or (impc:ir:type? res)
                   (and (list? res)
                        (= (length res) 1)
                        (impc:ir:type? (car res)))))
          (set! res (impc:ti:type-unify (impc:ti:type-check (caddr ast) vars kts request?) vars)))
      ;; (println 'bbbb: res '-> request? request?) ;  '-> (caddr ast))
      ;; if we have a choice between numeric options we force one!
      (if (and (not (impc:ti:complex-type? res))
               (list? res)
               (> (length res) 1)
               (not (member #f (map (lambda (t) (impc:ir:floating-point? t)) res))))
          (set! res (list (apply min res)))) ;;(list *impc:ir:fp64*))) ;; force doubles
      (if (and (not (impc:ti:complex-type? res))
               (list? res)
               (> (length res) 1)
               (not (member #f (map (lambda (t) (impc:ir:fixed-point? t)) res))))
          (set! res (list (apply min res)))) ;; (list *impc:ir:si64*))) ;; force i64
      ;; if we now have a valid type - then sending type to body!
      (if (and (list? res)
               (= (length res) 1)
               (impc:ir:type? (car res)))
          (begin (impc:ti:type-check (caddr ast) vars kts (car res))
                 (set! res (car res))))
      ;; return lambda type which is made up of
      ;; argument symbols plus return type from last body expression
      (let* ((ret (list (impc:ir:pointer++ (list* *impc:ir:closure* res (cadr ast)) 2)))
             (uret (impc:ti:type-unify ret vars)))
        (if (not (null? uret))
            (map (lambda (sym req)
                   ;; (println 'larg: sym 'req: req)
                   (if (symbol? sym)
                       (impc:ti:update-var sym vars kts (impc:ti:type-unify req vars))))
                 (cadr ast)
                 (cddr uret)))
        ;; (println 'vars3 vars)
        (if (null? uret) ret uret)))))