4e987026 |
;;; This file contains error handlers for the type checker.
(define (type-error msg . args)
(apply (function phase-error) `(type-error ,msg ,@args))
(report-non-local-type-error)
(continue-from-type-error))
(define (report-non-local-type-error)
(when (pair? (dynamic *type-error-handlers*))
(funcall (car (dynamic *type-error-handlers*)))))
(define (continue-from-type-error)
(funcall (car (dynamic *type-error-recovery*))))
(define (type-mismatch/fixed object msg type)
(format '#t "While typing ~A:~%~A~%Type: ~A~%" object msg type))
(define (type-mismatch object msg type1 type2)
(format '#t "While type checking~%~A~%~A~%Types: ~A~% ~A~%"
object msg type1 type2))
(define (type-mismatch/list types object msg)
(format '#t "While typing ~A:~%~A~%Types: ~%" object msg)
(dolist (type types)
(format '#t "~A~%" type)))
;;; Error handlers
(define (signature-mismatch var)
(format '#t
"Signature mismatch for ~A~%Inferred type: ~A~%Declared type: ~A~%"
var
(remove-type-wrapper (ntype->gtype (var-type var)))
(var-signature var)))
(define (remove-type-wrapper ty)
(if (recursive-type? ty) (recursive-type-type ty) ty))
|