diff options
author | Yale AI Dept <ai@nebula.cs.yale.edu> | 1993-07-14 13:08:00 -0500 |
---|---|---|
committer | Duncan McGreggor <duncan.mcgreggor@rackspace.com> | 1993-07-14 13:08:00 -0500 |
commit | 4e987026148fe65c323afbc93cd560c07bf06b3f (patch) | |
tree | 26ae54177389edcbe453d25a00c38c2774e8b7d4 /type/type-error-handlers.scm |
Import to github.
Diffstat (limited to 'type/type-error-handlers.scm')
-rw-r--r-- | type/type-error-handlers.scm | 40 |
1 files changed, 40 insertions, 0 deletions
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 |