diff options
| -rw-r--r-- | chickadee/graphics/seagull.scm | 22 |
1 files changed, 19 insertions, 3 deletions
diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm index d1a90da..e1db052 100644 --- a/chickadee/graphics/seagull.scm +++ b/chickadee/graphics/seagull.scm @@ -1333,7 +1333,7 @@ (define (unify:primitives a b success) (if (equal? a b) (success '()) - (unify:fail "type mismatch" a b))) + (unify:fail "primitive type mismatch" a b))) (define (unify:variable a b success) (cond @@ -1579,6 +1579,15 @@ (resolve:list exps env)) (_ exp))) +(define &seagull-type-error + (make-exception-type '&seagull-type-error &error '())) + +(define make-seagull-type-error + (record-constructor &seagull-type-error)) + +;; TODO: Add some kind of context object that is threaded through the +;; inference process so that when a type error occurs we can show the +;; expression that caused it. (define (infer-types exp stage) (call-with-unify-rollback (lambda () @@ -1587,8 +1596,15 @@ '() (lambda (subs) (resolve annotated subs))))) - (lambda args - (apply error args)))) + (match-lambda* + ((msg . args) + (raise-exception + (make-exception + (make-seagull-type-error) + (make-exception-with-origin infer-types) + (make-exception-with-message + (format #f "seagull type error: ~a" msg)) + (make-exception-with-irritants args))))))) ;;; |