classes: Add a check that arguments to classoids are themselves classoids.

Introduce a new word-prop that makes tuple-class words classoids at parse-time so that
self-referential tuple definitions with maybe{} work, e.g. TUPLE: node { next maybe{ node } } ;
Add unit test.
Fixes #766.

core/classes/algebra/algebra.factor

@@ -15,7 +15,19 @@ TUPLE: anonymous-union { members read-only } ;
 
 INSTANCE: anonymous-union classoid
 
-: <anonymous-union> ( members -- class )
+ERROR: not-classoids sequence ;
+
+: check-classoids ( members -- members )
+    dup [ classoid? ] all?
+    [ [ classoid? not ] filter not-classoids ] unless ;
+
+ERROR: not-a-classoid object ;
+
+: check-classoid ( object -- object )
+    dup classoid? [ not-a-classoid ] unless ;
+
+: <anonymous-union> ( members -- classoid )
+    check-classoids
     [ null eq? not ] filter set-members
     dup length 1 = [ first ] [ sort-classes f like anonymous-union boa ] if ;
 
@@ -25,7 +37,8 @@ TUPLE: anonymous-intersection { participants read-only } ;
 
 INSTANCE: anonymous-intersection classoid
 
-: <anonymous-intersection> ( participants -- class )
+: <anonymous-intersection> ( participants -- classoid )
+    check-classoids
     set-members dup length 1 =
     [ first ] [ sort-classes f like anonymous-intersection boa ] if ;
 
@@ -35,7 +48,9 @@ TUPLE: anonymous-complement { class read-only } ;
 
 INSTANCE: anonymous-complement classoid
 
-C: <anonymous-complement> anonymous-complement
+: <anonymous-complement> ( object -- classoid )
+    dup classoid? [ 1array not-classoids ] unless
+    anonymous-complement boa ;
 
 M: anonymous-complement rank-class drop 3 ;
 

core/classes/classes.factor

@@ -10,8 +10,11 @@ ERROR: bad-inheritance class superclass ;
 
 PREDICATE: class < word "class" word-prop ;
 
+PREDICATE: defining-class < word "defining-class" word-prop ;
+
 MIXIN: classoid
 INSTANCE: class classoid
+INSTANCE: defining-class classoid
 
 <PRIVATE
 
@@ -52,6 +55,7 @@ GENERIC: reset-class ( class -- )
 
 M: class reset-class
     {
+        "defining-class"
         "class"
         "metaclass"
         "superclass"

core/classes/maybe/maybe-tests.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2011 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes.maybe eval generic.single kernel tools.test
-math classes accessors slots classes.algebra ;
+math classes accessors slots classes.algebra
+classes.algebra.private ;
 IN: classes.maybe.tests
 
 [ t ] [ 3 maybe{ integer } instance? ] unit-test
@@ -64,3 +65,6 @@ M: f lol2 drop "lol22" ;
 
 [ t ] [ \ + <maybe> classoid? ] unit-test
 [ f ] [ \ + <maybe> valid-classoid? ] unit-test
+
+[ "IN: classes-tests maybe{ 1 2 3 }" eval( -- ) ]
+[ error>> not-classoids? ] must-fail-with

core/classes/parser/parser.factor

@@ -8,6 +8,7 @@ IN: classes.parser
 
 : create-class-in ( string -- word )
     current-vocab create
+    dup t "defining-class" set-word-prop
     dup set-word
     dup save-class-location
     dup create-predicate-word save-location ;

core/classes/tuple/tuple.factor

@@ -238,10 +238,12 @@ M: tuple-class update-class
     } cleave ;
 
 : define-new-tuple-class ( class superclass slots -- )
-    [ drop f f tuple-class define-class ]
-    [ nip "slots" set-word-prop ]
-    [ 2drop update-classes ]
-    3tri ;
+    {
+        [ drop f f tuple-class define-class ]
+        [ nip "slots" set-word-prop ]
+        [ 2drop update-classes ]
+        [ 2drop f "defining-class" set-word-prop ]
+    } 3cleave ;
 
 : subclasses ( class -- classes )
     class-usages [ tuple-class? ] filter ;