Defining an "error-class", and printing error tuples out with ERROR:. See #188.

diff --git a/basis/see/see.factor b/basis/see/see.factor
index 38a8a489349ad557bd603a0a6941c3ea67a14710..800709db95aa18340c746a497e0d724c4efa765f 100644 (file)
--- a/basis/see/see.factor
+++ b/basis/see/see.factor
@@ -191,8 +191,8 @@ M: array pprint-slot-name
 : superclass. ( class -- )
     superclass dup tuple eq? [ drop ] [ "<" text pprint-word ] if ;
 
-M: tuple-class see-class*
-    <colon \ TUPLE: pprint-word
+: pprint-tuple-class ( class definer -- )
+    <colon pprint-word
     {
         [ pprint-word ]
         [ superclass. ]
@@ -201,6 +201,12 @@ M: tuple-class see-class*
     } cleave
     block> ;
 
+M: tuple-class see-class*
+    \ TUPLE: pprint-tuple-class ;
+
+M: error-class see-class* ( class -- )
+    \ ERROR: pprint-tuple-class ;
+
 M: word see-class* drop ;
 
 M: builtin-class see-class*

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index d67875046e67d3317f875ef6ac7547000e4ce01b..ab61fa6c37c82e78245a706c7a62007203588ea0 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -290,16 +290,21 @@ M: tuple-class (define-tuple-class)
     3dup tuple-class-unchanged?
     [ 2drop ?define-symbol ] [ redefine-tuple-class ] if ;
 
+PREDICATE: error-class < tuple-class
+    "error-class" word-prop ;
+
 : define-error-class ( class superclass slots -- )
-    error-slots
-    [ define-tuple-class ]
-    [ 2drop reset-generic ]
-    [
-        2drop
-        [ dup [ boa throw ] curry ]
-        [ all-slots thrower-effect ]
-        bi define-declared
-    ] 3tri ;
+    error-slots {
+        [ define-tuple-class ]
+        [ 2drop reset-generic ]
+        [ 2drop t "error-class" set-word-prop ]
+        [
+            2drop
+            [ dup [ boa throw ] curry ]
+            [ all-slots thrower-effect ]
+            bi define-declared
+        ]
+    } 3cleave ;
 
 : boa-effect ( class -- effect )
     [ all-slots [ name>> ] map ] [ name>> 1array ] bi <effect> ;