impc:ti:symbol-check   scheme

(define impc:ti:symbol-check
  (lambda (ast vars kts request?)
    ;; (println 'symchk ast 'vars: vars 'req: request?)
    ;; (println 'symcheck 'ast: ast 'request? request? (impc:ir:get-base-type (symbol->string ast)))
    (cond ((not (symbol? ast))
           (impc:compiler:print-compiler-error "Trying to symbol check a non-symbol" ast))
          ((assoc-strcmp ast kts)
           (list (cdr (assoc-strcmp ast vars))))
          ((and
            (assoc-strcmp ast vars)
            (impc:ir:type? (impc:ti:type-unify (cdr (assoc-strcmp ast vars)) vars))
            (if request?
                (equal? request? (impc:ti:type-unify (cdr (assoc-strcmp ast vars)) vars))
                #t))
           (begin
             ;; (println '.................saving-time!)
             (list (impc:ti:type-unify (cdr (assoc-strcmp ast vars)) vars))))
          ((impc:ti:globalvar-exists? (symbol->string ast))
           (list (impc:ir:pointer-- (impc:ti:get-globalvar-type (symbol->string ast)))))
          ((impc:ti:nativefunc-exists? (symbol->string ast))
           (list (impc:ti:get-nativefunc-type (symbol->string ast))))
          (else
           (if (and (symbol? ast)
                    (impc:ti:genericfunc-exists? (string->symbol (impc:ir:get-base-type (symbol->string ast)))))
               (begin
                 (impc:compiler:print-compiler-error "Try forcing a type? Ambiguous generic function as value" ast)))
           (if (and (symbol? ast)
                    (impc:ti:polyfunc-exists? (impc:ir:get-base-type (symbol->string ast))))
               (let ((pt (impc:ti:get-polyfunc-candidate-types (impc:ir:get-base-type (symbol->string ast)))))
                 (cond ((and (> (length pt) 1)
                             (assoc request? pt))
                        (if (assoc-strcmp ast vars) (impc:ti:update-var ast vars kts (list request?)))
                        (set! ast (string->symbol (string-append (impc:ir:get-base-type (symbol->string ast))
                                                                 ":" (impc:ir:pretty-print-type request?)))))
                       ((= (length pt) 1)
                        (if (assoc-strcmp ast vars) (impc:ti:update-var ast vars kts pt))
                        (set! ast (string->symbol (string-append (impc:ir:get-base-type (symbol->string ast))
                                                                 ":" (impc:ir:pretty-print-type (car pt))))))
                       (else
                        (impc:compiler:print-compiler-error
                         "Try forcing a type? Ambiguous polymorphic function as a value" ast)))))
           (if *impc:ti:print-sub-checks* (println 'sym:> 'ast: ast 'request? request?))
           ;; if a request is made - assume it's forced
           ;; find the intersection between the request
           ;; and the current values and force that intersection
           (let ((polytype #f))
             (if (and (not (assoc-strcmp ast vars))
                      (not (impc:ti:closure-exists? (symbol->string ast)))
                      (not (impc:ti:globalvar-exists? (symbol->string ast))))
                 (if (and (string-contains? (symbol->string ast) ":")
                          (or (impc:ti:genericfunc-exists?
                               (string->symbol (car (regex:type-split (symbol->string ast) ":"))))
                              (impc:ti:polyfunc-exists? (car (regex:type-split (symbol->string ast) ":")))))
                     (let* ((p (regex:type-split (symbol->string ast) ":"))
                            (t (if (impc:ti:typealias-exists? (cadr p))
                                   (impc:ir:pretty-print-type (impc:ti:get-typealias-type (cadr p)))
                                   (cadr p)))
                            (etype (cname-encode (impc:ir:get-base-type t))))
                       ;; (println 'ast: ast 'etype: etype)
                       (begin
                         (set! request? #f)
                         (if (impc:ti:polyfunc-exists? (car p))
                             (set! ast (string->symbol (string-append (car p) "_adhoc_" etype)))
                             (set! ast (string->symbol (string-append (car p) "_poly_" etype))))
                         (set! polytype (impc:ir:get-type-from-pretty-str t))))
                     (begin (impc:compiler:print-missing-identifier-error ast 'symbol))))
             (let ((type (if polytype polytype
                             (if (assoc-strcmp ast vars)
                                 (cdr (assoc-strcmp ast vars))
                                 (if (impc:ti:closure-exists? (symbol->string ast))
                                     (list (cons (+ *impc:ir:closure* *impc:ir:pointer* *impc:ir:pointer*) (map impc:ir:get-type-from-str (impc:ti:get-closure-arg-types (symbol->string ast)))))
                                     (list (impc:ir:pointer-- (impc:ti:get-globalvar-type (symbol->string ast)))))))))
               ;; (println '---------- (member ast kts) 'type: type (impc:ir:type? type))
               (if (and request?
                        (not (member ast kts)) ;; if we're in KTS then we should ignore requests!
                        (not (null? request?)))
                   (if (null? type)
                       (begin
                         (impc:ti:update-var ast vars kts (list request?))
                         request?)
                       (let ((intersection (impc:ti:type-unify (list request? type) vars)))
                         ;; (println 'intersection intersection 'request? request? 'type: type 'ast: ast)
                         (if (not (null? intersection))
                             (begin
                               ;; andrew change
                               (impc:ti:force-var ast vars kts (list intersection))
                               ;;(impc:ti:force-var ast vars kts (list request?)) ;(list intersection))
                               ;;(impc:ti:update-var ast vars kts (list intersection))
                               (list intersection))
                             type)))
                   type)))))))