From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001 From: Yale AI Dept Date: Wed, 14 Jul 1993 13:08:00 -0500 Subject: Import to github. --- type/type-error-handlers.scm | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 type/type-error-handlers.scm (limited to 'type/type-error-handlers.scm') diff --git a/type/type-error-handlers.scm b/type/type-error-handlers.scm new file mode 100644 index 0000000..ac7af9c --- /dev/null +++ b/type/type-error-handlers.scm @@ -0,0 +1,40 @@ +;;; 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)) + + + \ No newline at end of file -- cgit v1.2.3