blob: ac7af9cc703887f48d4887b8434f6d4510f875ce (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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))
|
