- (cond
- ((integer? x) (list '() 'int))
- ((boolean? x) (list '() 'bool))
- ((eq? x 'inc) (list '() '(abs int int)))
- ((symbol? x) (list '() (env-lookup env x)))
-
- ((is-lambda? x)
- (let* ((new-env (cons (cons (lambda-arg x) (fresh-tvar)) env))
- (body-type-res (typecheck new-env (lambda-body x)))
- (subd-env (substitute (car body-type-res) new-env)))
- (display "lambda: ")
- (display body-type-res)
- (display "\n")
+ (case (ast-type x)
+ ('int-literal (list '() 'int))
+ ('bool-literal (list '() 'bool))
+ ('string-literal (list '() 'string))
+ ('builtin (list '() (builtin-type x)))
+
+ ('if
+ (let* ((cond-type-res (check env (cadr x)))
+ (then-type-res (check env (caddr x)))
+ (else-type-res (check env (cadddr x)))
+ (then-eq-else-cs (unify (cadr then-type-res)
+ (cadr else-type-res)))
+ (cs (consolidate
+ (car then-type-res)
+ (consolidate (car else-type-res)
+ then-eq-else-cs)))
+ (return-type (substitute cs (cadr then-type-res))))
+ (when (not (eqv? (cadr cond-type-res) 'bool))
+ (error #f "if condition isn't bool"))
+ (list cs return-type)))
+
+ ('var (list '() (env-lookup env x)))
+ ('let
+ (let ((new-env (fold-left
+ (lambda (acc bind)
+ (let ((t (check
+ (env-insert acc (car bind) (fresh-tvar))
+ (cadr bind))))
+ (env-insert acc (car bind) (cadr t))))
+ env (let-bindings x))))
+ (check new-env (last (let-body x)))))
+
+
+ ('lambda
+ (let* ((new-env (env-insert env (lambda-arg x) (fresh-tvar)))
+ (body-type-res (check new-env (lambda-body x)))
+ (cs (car body-type-res))
+ (subd-env (substitute-env (car body-type-res) new-env))
+ (arg-type (env-lookup subd-env (lambda-arg x)))
+ (resolved-arg-type (substitute cs arg-type)))
+ ;; (display "lambda:\n\t")
+ ;; (display prog)
+ ;; (display "\n\t")
+ ;; (display cs)
+ ;; (display "\n\t")
+ ;; (display resolved-arg-type)
+ ;; (newline)