Add exception type for type errors.

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)))))))
 
 
 ;;;