(define impc:ti:compare-check
(lambda (ast vars kts request?)
(let* ((n1 (if (number? (cadr ast)) (caddr ast) (cadr ast)))
(n2 (if (number? (cadr ast)) (cadr ast) (caddr ast)))
(a (impc:ti:type-unify (impc:ti:type-check n1 vars kts #f) vars)) ;; removed request?
(b (impc:ti:type-unify (impc:ti:type-check n2 vars kts #f) vars)) ;; removed request?
(t (impc:ti:type-unify (list a b) vars)))
;; (println 'a a 'b b 't t 'req? request?)
;; if we can unify on 't'
;; then we might need to retypecheck a or b
(if (impc:ir:type? t)
(begin
(if (and (list? a)
(list? n1)
(assoc-strcmp (car n1) vars))
(begin (impc:ti:force-var (car n1) vars kts '())
(impc:ti:type-check n1 vars kts t)))
(if (and (list? b)
(list? n2)
(assoc-strcmp (car n2) vars))
(begin (impc:ti:force-var (car n2) vars kts '())
(impc:ti:type-check n2 vars kts t)))))
(if *impc:ti:print-sub-checks* (println 'compare:> 'ast: ast 'a: a 'b: b 't: t 'request? request?))
(if (not (null? t))
(begin (if (symbol? (cadr ast)) (impc:ti:force-var (cadr ast) vars kts t))
(if (symbol? (caddr ast)) (impc:ti:force-var (caddr ast) vars kts t))
(if (and (not (null? t))
(impc:ir:vector? t))
(if (impc:ir:pointer? t)
(list (- (car t) *impc:ir:pointer*) (cadr t) *impc:ir:i1*)
(list (car t) (cadr t) *impc:ir:i1*))
;; (if (and (impc:ir:tuple? t)
;; (not (impc:ir:pointer? t)))
(if (impc:ir:tuple? t)
t
(list *impc:ir:i1*))))
(cond ((impc:ir:vector? a)
(if (symbol? (cadr ast)) (impc:ti:update-var (cadr ast) vars kts a))
(let ((retvec (if (impc:ir:pointer? a) (impc:ir:pointer-- a) a)))
(list (car retvec) (cadr retvec) *impc:ir:i1*)))
((impc:ir:vector? b)
(if (symbol? (caddr ast)) (impc:ti:update-var (cadr ast) vars kts b))
(let ((retvec (if (impc:ir:pointer? b) (impc:ir:pointer-- b) b)))
(list (car retvec) (cadr retvec) *impc:ir:i1*)))
;; ((or (and (impc:ir:tuple? a) (not (impc:ir:pointer? a)))
;; (and (impc:ir:tuple? b) (not (impc:ir:pointer? b))))
;; (list (if (impc:ir:tuple? a) a b)))
((or (impc:ir:tuple? a)
(impc:ir:tuple? b))
(list (if (impc:ir:tuple? a) a b)))
((not (cl:find-if symbol? (cdr ast))) (list *impc:ir:i1*)) ;; return t
((and (symbol? n1)
(symbol? n2)
(not (null? (cdr (impc:ti:get-var n1 vars))))
(not (null? (cdr (impc:ti:get-var n2 vars)))))
;; if both are symbols and their types cannot unify on anything
;; then we have a problem! So force both types to NULL
(impc:ti:force-var n1 vars kts '())
(impc:ti:force-var n2 vars kts '())
(list *impc:ir:i1*)) ;; and return t (which should be NULL)
((and (symbol? n1) (not (null? b)))
(impc:ti:update-var n1 vars kts b)
(list *impc:ir:i1*)) ;; return b
((and (symbol? n2) (not (null? a)))
(impc:ti:update-var n2 vars kts a)
(list *impc:ir:i1*)) ;; return a
(else (list *impc:ir:i1*)))))))