Old fix for classes-intersect? no-method bug was incorrect; we were

ignoring anonymous classes in compiled-generic-crossref. Also,
forget* now calls reset-word so that references to predicates of
forgotten classes don't break the compiler with a similar error.

basis/compiler/tests/redefine12.factor

@@ -0,0 +1,20 @@
+USING: kernel tools.test eval ;
+IN: compiler.tests.redefine12
+
+! A regression that came about when fixing the
+! 'no method on classes-intersect?' bug
+
+GENERIC: g ( a -- b )
+
+M: object g drop t ;
+
+: h ( a -- b ) dup [ g ] when ;
+
+[ f ] [ f h ] unit-test
+[ t ] [ "hi" h ] unit-test
+
+TUPLE: jeah ;
+
+[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" eval ] unit-test
+
+[ f ] [ T{ jeah } h ] unit-test

core/classes/algebra/algebra.factor

@@ -20,6 +20,14 @@ C: <anonymous-complement> anonymous-complement
 : 2cache ( key1 key2 assoc quot -- value )
     >r >r 2array r> [ first2 ] r> compose cache ; inline
 
+GENERIC: valid-class? ( obj -- ? )
+
+M: class valid-class? drop t ;
+M: anonymous-union valid-class? members>> [ valid-class? ] all? ;
+M: anonymous-intersection valid-class? participants>> [ valid-class? ] all? ;
+M: anonymous-complement valid-class? class>> valid-class? ;
+M: word valid-class? drop f ;
+
 DEFER: (class<=)
 
 : class<= ( first second -- ? )

core/classes/classes-tests.factor

@@ -79,3 +79,37 @@ USE: multiline
     : q ( -- b ) j new g ;"> <string-reader>
     "class-intersect-no-method-b" parse-stream drop
 ] unit-test
+
+! Similar problem, but with anonymous classes
+[ ] [
+    <" IN: classes.test.c
+    USE: kernel
+    GENERIC: g ( a -- b )
+    M: object g ;
+    TUPLE: z ;"> <string-reader>
+    "class-intersect-no-method-c" parse-stream drop
+] unit-test
+
+[ ] [
+    <" IN: classes.test.d
+    USE: classes.test.c
+    USE: kernel
+    : q ( a -- b ) dup z? [ g ] unless ;"> <string-reader>
+    "class-intersect-no-method-d" parse-stream drop
+] unit-test
+
+! Now, the user removes the z class and adds a method,
+[ ] [
+    <" IN: classes.test.c
+    USE: kernel
+    GENERIC: g ( a -- b )
+    M: object g ;
+    TUPLE: j ;
+    M: j g ;"> <string-reader>
+    "class-intersect-no-method-c" parse-stream drop
+] unit-test
+
+TUPLE: forgotten-predicate-test ;
+
+[ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
+[ f ] [ \ forgotten-predicate-test? predicate? ] unit-test

core/classes/classes.factor

@@ -32,8 +32,7 @@ SYMBOL: update-map
 
 SYMBOL: implementors-map
 
-PREDICATE: class < word
+PREDICATE: class < word "class" word-prop ;
-    "class" word-prop ;
 
 : classes ( -- seq ) implementors-map get keys ;
 
@@ -42,9 +41,12 @@ PREDICATE: class < word
 
 PREDICATE: predicate < word "predicating" word-prop >boolean ;
 
+M: predicate reset-word
+    [ call-next-method ] [ { "predicating" } reset-props ] bi ;
+
 : define-predicate ( class quot -- )
-    >r "predicate" word-prop first
+    [ "predicate" word-prop first ] dip
-    r> (( object -- ? )) define-declared ;
+    (( object -- ? )) define-declared ;
 
 : superclass ( class -- super )
     #! Output f for non-classes to work with algebra code
@@ -121,13 +123,13 @@ M: sequence implementors [ implementors ] gather ;
     ] H{ } make-assoc ;
 
 : (define-class) ( word props -- )
-    >r
+    [
-    dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless
+        dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless
-    dup reset-class
+        dup reset-class
-    dup deferred? [ dup define-symbol ] when
+        dup deferred? [ dup define-symbol ] when
-    dup redefined
+        dup redefined
-    dup props>>
+        dup props>>
-    r> assoc-union >>props
+    ] dip assoc-union >>props
     dup predicate-word
     [ 1quotation "predicate" set-word-prop ]
     [ swap "predicating" set-word-prop ]

core/compiler/units/units.factor

@@ -111,7 +111,7 @@ SYMBOL: remake-generics-hook
 : (compiled-generic-usages) ( generic class -- assoc )
     [ compiled-generic-usage ] dip
     [
-        2dup [ class? ] both?
+        2dup [ valid-class? ] both?
         [ classes-intersect? ] [ 2drop f ] if nip
     ] curry assoc-filter ;
 

core/words/words.factor

@@ -204,13 +204,9 @@ GENERIC: reset-word ( word -- )
 
 M: word reset-word
     {
-        "unannotated-def"
+        "unannotated-def" "parsing" "inline" "recursive"
-        "parsing" "inline" "recursive" "foldable" "flushable"
+        "foldable" "flushable" "reading" "writing" "reader"
-        "predicating"
+        "writer" "declared-effect" "delimiter"
-        "reading" "writing"
-        "reader" "writer"
-        "constructing"
-        "declared-effect" "constructor-quot" "delimiter"
     } reset-props ;
 
 GENERIC: subwords ( word -- seq )
@@ -261,7 +257,7 @@ M: word forget*
     dup "forgotten" word-prop [ drop ] [
         [ delete-xref ]
         [ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
-        [ t "forgotten" set-word-prop ]
+        [ [ reset-word ] [ t "forgotten" set-word-prop ] bi ]
         tri
     ] if ;