Fixing interaction between mixin classes and forget

core/classes/classes-docs.factor

@@ -119,7 +119,7 @@ HELP: predicate-word
 { $values { "word" "a word" } { "predicate" "a predicate word" } }
 { $description "Suffixes the word's name with \"?\" and creates a word with that name in the same vocabulary as the word itself." } ;
 
-HELP: define-predicate
+HELP: define-predicate*
 { $values { "class" class } { "predicate" "a predicate word" } { "quot" "a quotation" } }
 { $description
     "Defines a predicate word. This is identical to a word definition associating " { $snippet "quot" } " with " { $snippet "predicate" } " with the added perk that three word properties are set:"
@@ -132,6 +132,13 @@ HELP: define-predicate
 }
 $low-level-note ;
 
+HELP: define-predicate
+{ $values { "class" class } { "quot" "a quotation" } }
+{ $description
+    "Defines a predicate word named " { $snippet "class?" } " with " { $link define-predicate* } "."
+}
+$low-level-note ;
+
 HELP: superclass
 { $values { "class" class } { "super" class } }
 { $description "Outputs the superclass of a class. All instances of this class are also instances of the superclass." }

core/classes/classes.factor

@@ -31,13 +31,16 @@ PREDICATE: class tuple-class
 
 PREDICATE: word predicate "predicating" word-prop >boolean ;
 
-: define-predicate ( class predicate quot -- )
+: define-predicate* ( class predicate quot -- )
     over [
         dupd predicate-effect define-declared
         2dup 1quotation "predicate" set-word-prop
         swap "predicating" set-word-prop
-    ] [
+    ] [ 3drop ] if ;
-        3drop
+
+: define-predicate ( class quot -- )
+    over "forgotten" word-prop [ 2drop ] [
+        >r dup predicate-word r> define-predicate*
     ] if ;
 
 : superclass ( class -- super )

core/classes/predicate/predicate.factor

@@ -16,7 +16,7 @@ PREDICATE: class predicate-class
 : define-predicate-class ( superclass class definition -- )
     >r dup f roll predicate-class define-class r>
     dupd "predicate-definition" set-word-prop
-    dup predicate-word over predicate-quot define-predicate ;
+    dup predicate-quot define-predicate ;
 
 M: predicate-class reset-class
     {

core/classes/union/union.factor

@@ -31,9 +31,7 @@ PREDICATE: class union-class
     ] if ;
 
 : define-union-predicate ( class -- )
-    dup predicate-word
+    dup members union-predicate-quot define-predicate ;
-    over members union-predicate-quot
-    define-predicate ;
 
 M: union-class update-predicate define-union-predicate ;
 

core/tuples/tuples.factor

@@ -66,9 +66,7 @@ M: tuple-class tuple-size "slot-names" word-prop length 2 + ;
 PRIVATE>
 
 : define-tuple-predicate ( class -- )
-    dup predicate-word
+    dup [ tuple-class-eq? ] curry define-predicate ;
-    over [ tuple-class-eq? ] curry
-    define-predicate ;
 
 : delegate-slot-spec
     T{ slot-spec f

core/words/words.factor

@@ -172,7 +172,9 @@ SYMBOL: changed-words
     gensym dup rot define ;
 
 : reveal ( word -- )
-    dup word-name over word-vocabulary vocab-words set-at ;
+    dup word-name over word-vocabulary dup vocab-words
+    [ ] [ no-vocab ] ?if
+    set-at ;
 
 TUPLE: check-create name vocab ;