Changing the stack effect of a generic word could break the compiler

basis/compiler/tests/redefine16.factor

@@ -0,0 +1,10 @@
+IN: compiler.tests.redefine16
+USING: eval tools.test definitions words compiler.units
+quotations stack-checker ;
+
+[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- )" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine16 USING: strings math arrays prettyprint ; M: string blah 1 + 3array . ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test
+[ "blah" "compiler.tests.redefine16" lookup 1quotation infer ] must-fail

basis/compiler/tree/optimizer/optimizer.factor

@@ -18,11 +18,18 @@ IN: compiler.tree.optimizer
 
 SYMBOL: check-optimizer?
 
+: ?check ( nodes -- nodes' )
+    check-optimizer? get [
+        compute-def-use
+        dup check-nodes
+    ] when ;
+
 : optimize-tree ( nodes -- nodes' )
     analyze-recursive
     normalize
     propagate
     cleanup
+    ?check
     dup run-escape-analysis? [
         escape-analysis
         unbox-tuples
@@ -30,10 +37,7 @@ SYMBOL: check-optimizer?
     apply-identities
     compute-def-use
     remove-dead-code
-    check-optimizer? get [
+    ?check
-        compute-def-use
-        dup check-nodes
-    ] when
     compute-def-use
     optimize-modular-arithmetic
     finalize ;

basis/stack-checker/known-words/known-words.factor

@@ -218,6 +218,8 @@ M: object infer-call*
     alien-callback
 } [ t "special" set-word-prop ] each
 
+M\ quotation call t "no-compile" set-word-prop
+M\ word execute t "no-compile" set-word-prop
 \ clear t "no-compile" set-word-prop
 
 : non-inline-word ( word -- )

core/words/words.factor

@@ -68,10 +68,6 @@ M: word crossref?
         vocabulary>> >boolean
     ] if ;
 
-GENERIC: compiled-crossref? ( word -- ? )
-
-M: word compiled-crossref? crossref? ;
-
 GENERIC# (quot-uses) 1 ( obj assoc -- )
 
 M: object (quot-uses) 2drop ;
@@ -131,26 +127,38 @@ compiled-generic-crossref [ H{ } clone ] initialize
 
 : inline? ( word -- ? ) "inline" word-prop ; inline
 
+GENERIC: subwords ( word -- seq )
+
+M: word subwords drop f ;
+
+<PRIVATE
+
 SYMBOL: visited
 
 CONSTANT: reset-on-redefine { "inferred-effect" "cannot-infer" }
 
+: relevant-callers ( word -- seq )
+    crossref get at keys
+    [ word? ] filter
+    [
+        [ reset-on-redefine [ word-prop ] with any? ]
+        [ inline? ]
+        bi or
+    ] filter ;
+
 : (redefined) ( word -- )
     dup visited get key? [ drop ] [
         [ reset-on-redefine reset-props ]
         [ visited get conjoin ]
         [
-            crossref get at keys
+            [ relevant-callers [ (redefined) ] each ]
-            [ word? ] filter
+            [ subwords [ (redefined) ] each ]
-            [
+            bi
-                [ reset-on-redefine [ word-prop ] with any? ]
-                [ inline? ]
-                bi or
-            ] filter
-            [ (redefined) ] each
         ] tri
     ] if ;
 
+PRIVATE>
+
 : redefined ( word -- )
     [ H{ } clone visited [ (redefined) ] with-variable ]
     [ changed-definition ]
@@ -199,10 +207,6 @@ M: word reset-word
         "writer" "delimiter"
     } reset-props ;
 
-GENERIC: subwords ( word -- seq )
-
-M: word subwords drop f ;
-
 : reset-generic ( word -- )
     [ subwords forget-all ]
     [ reset-word ]