classes: adding a check-instance for checking type of things.

This will replace a bunch of not-a-thingy errors that we have in a few
places.  Those should probably go away anyway, in favor of better type
propagation or runtime JIT compilation.

diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor
index 59b11232c4fe93f4ec49f7872ef6366163a3aed9..ff2798030bf60d1d4f752236a7b6a3faad5c0aaf 100644 (file)
--- a/core/classes/classes-tests.factor
+++ b/core/classes/classes-tests.factor
@@ -140,3 +140,6 @@ GENERIC: generic-predicate? ( a -- b )
 } [
     f { fixnum } { } f  make-class-props
 ] unit-test
+
+{ "test" } [ "test" sequence check-instance ] unit-test
+[ "test" fixnum check-instance ] [ not-an-instance? ] must-fail-with

diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index c41f3152fa7bab566c43e72250899cb6b62ccbeb..f33d8bbaf756f2b6f17a13206d0a451afb6c2ff8 100644 (file)
--- a/core/classes/classes.factor
+++ b/core/classes/classes.factor
@@ -220,11 +220,11 @@ GENERIC: update-methods ( class seq -- )
     dup class-usages
     [ nip [ update-class ] each ] [ update-methods ] 2bi ;
 
-: check-inheritance ( subclass superclass -- )
-    2dup superclass-of? [ bad-inheritance ] [ 2drop ] if ;
+: check-inheritance ( subclass superclass -- subclass superclass )
+    2dup superclass-of? [ bad-inheritance ] when ;
 
 : define-class ( word superclass members participants metaclass -- )
-    [ 2dup check-inheritance ] 3dip
+    [ check-inheritance ] 3dip
     make-class-props [ (define-class) ] [ drop changed-definition ] 2bi ;
 
 : forget-predicate ( class -- )
@@ -255,3 +255,8 @@ M: class metaclass-changed
 
 M: class forget* ( class -- )
     [ call-next-method ] [ forget-class ] bi ;
+
+ERROR: not-an-instance obj class ;
+
+: check-instance ( obj class -- obj )
+    [ dupd instance? ] keep [ not-an-instance ] curry unless ; inline