git.fiddlerwoaroof.com
type/type-error-handlers.scm
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))