classes.error: It was in the other patch but not this one...

diff --git a/core/classes/error/authors.txt b/core/classes/error/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/core/classes/error/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/core/classes/error/error-tests.factor b/core/classes/error/error-tests.factor
new file mode 100644 (file)
index 0000000..80c881d
--- /dev/null
+++ b/core/classes/error/error-tests.factor
@@ -0,0 +1,40 @@
+! Copyright (C) 2015 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors classes classes.error classes.tuple
+compiler.units effects eval generic io.streams.string kernel
+math namespaces parser tools.test words words.symbol ;
+IN: classes.error.tests
+
+! Test error classes
+ERROR: error-class-test a b c ;
+
+{ "( a b c -- * )" } [ \ throw-error-class-test stack-effect effect>string ] unit-test
+{ f } [ \ throw-error-class-test "inline" word-prop ] unit-test
+
+[ "IN: classes.error.tests ERROR: error-x ; : error-x 3 ;" eval( -- ) ]
+[ error>> error>> redefine-error? ] must-fail-with
+
+DEFER: error-y
+
+{ } [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test
+
+{ } [ "IN: classes.error.tests GENERIC: error-y ( a -- b )" eval( -- ) ] unit-test
+
+{ f } [ \ error-y tuple-class? ] unit-test
+
+{ f } [ \ error-y error-class? ] unit-test
+
+{ t } [ \ error-y generic? ] unit-test
+
+{ } [ "IN: classes.error.tests ERROR: error-y ;" eval( -- ) ] unit-test
+
+{ t } [ \ error-y tuple-class? ] unit-test
+
+{ t } [ \ error-y error-class? ] unit-test
+
+{ f } [ \ error-y generic? ] unit-test
+
+ERROR: base-error x y ;
+ERROR: derived-error < base-error z ;
+
+{ ( x y z -- * ) } [ \ throw-derived-error stack-effect ] unit-test

diff --git a/core/classes/error/error.factor b/core/classes/error/error.factor
new file mode 100644 (file)
index 0000000..ca9d0ba
--- /dev/null
+++ b/core/classes/error/error.factor
@@ -0,0 +1,32 @@
+! Copyright (C) 2015 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors classes.private classes.tuple
+classes.tuple.private combinators kernel parser sequences words ;
+IN: classes.error
+
+PREDICATE: error-class < tuple-class
+    "error-class" word-prop ;
+
+M: error-class reset-class
+    [ call-next-method ] [ "error-class" remove-word-prop ] bi ;
+
+: define-error-class ( class superclass slots -- )
+    error-slots {
+        [ define-tuple-class ]
+        [ 2drop reset-generic ]
+        [ 2drop t "error-class" set-word-prop ]
+        [
+            2drop
+            [ ]
+            [ [ boa throw ] curry ]
+            [ all-slots thrower-effect ]
+            tri define-declared
+        ]
+        [
+            2drop
+            [ name>> "throw-" prepend create-word-in [ reset-generic ] keep ]
+            [ [ boa throw ] curry ]
+            [ all-slots thrower-effect ]
+            tri define-declared
+        ]
+    } 3cleave ;