impc:ti:add-types-to-source   scheme

;; add types to source
;; also add clrun for closure application
;; and inject polymorphic functions
(define impc:ti:add-types-to-source
  (lambda (symname ast types envvars . prev)
    ;; (println 'symname: symname)
    ;; (println 'ast: ast)
    ;; (println 'types: types)
    ;; (println 'envvars: envvars 'prev: prev)
    (if (atom? ast) ;; ast
        (apply impc:ti:add-types-to-source-atom symname ast types envvars prev)
        (cond ((member (car ast) '(__make-closure __make-closure-s __make-closure-h __make-closure-z))
               (if *impc:compiler:print-work-names
                   (println '>> 'worker: (string-append (symbol->string symname) "__"
                                                        (number->string (+ 1 (llvm:count))))))
               (list (car ast)
                     (cadr ast)
                     ;; global name
                     (string-append (symbol->string symname) "__" (number->string (llvm:count++)))
                     (if (or (null? prev) ;; this adds return type
                             (null? (cdr (assoc-strcmp (car prev) types))))
                         *impc:ir:other*
                         (caddr (assoc-strcmp (car prev) types)))
                     (map (lambda (v) ;; environment types
                            (if (member v envvars)
                                (let ((p (assoc-strcmp v types)))
                                  (cons (string->symbol (string-append (symbol->string (car p)) "__sub"))
                                        (cdr p)))
                                (assoc-strcmp v types)))
                          (cons symname (caddr ast)))
                     (map (lambda (v) ;; argument types
                            (assoc-strcmp v types))
                          (cadddr ast))
                     (impc:ti:add-types-to-source symname (car (cddddr ast)) types (append envvars (caddr ast)))))
              ((equal? (car ast) 'clrun->)
               (if (and (assoc-strcmp (cadr ast) types)
                        (<> (length (cdddr (assoc-strcmp (cadr ast) types)))
                            (length (cddr ast))))
                   (impc:compiler:print-compiler-error "You must provide a full type for this call" (cdr ast)))
               (list* (car ast)
                      (cadr ast)
                      (map (lambda (arg type)
                             ;;(print 'clrunargs-> arg type)
                             (let ((a (impc:ti:add-types-to-source symname arg types envvars ast)))
                               (if (null? type)
                                   (impc:compiler:print-could-not-resolve-type-error
                                    (symbol->string (cadr ast)))
                                   a)))
                           (cddr ast)
                           (cdddr (if (not (assoc-strcmp (cadr ast) types)) ;; if not in local env then get types from global var
                                      (if (impc:ti:globalvar-exists? (symbol->string (cadr ast)))
                                          (cons (cadr ast) (impc:ti:get-globalvar-type (symbol->string (cadr ast))))
                                          (cons (cadr ast) (impc:ti:get-closure-type (symbol->string (cadr ast)))))
                                      (assoc-strcmp (cadr ast) types))))))