Remove "compiled-status" word prop and simplify associated machinery

basis/compiler/compiler.factor

@@ -28,23 +28,14 @@ SYMBOL: compiled
 : maybe-compile ( word -- )
     dup optimized>> [ drop ] [ queue-compile ] if ;
 
-SYMBOLS: +optimized+ +unoptimized+ ;
+: recompile-callers? ( word -- ? )
+    changed-effects get key? ;
 
-: ripple-up ( words -- )
+: recompile-callers ( words -- )
-    dup "compiled-status" word-prop +unoptimized+ eq?
+    dup recompile-callers? [
-    [ usage [ word? ] filter ] [ compiled-usage keys ] if
+        [ usage [ word? ] filter ] [ compiled-usage keys ] bi
-    [ queue-compile ] each ;
+        [ [ queue-compile ] each ] bi@
-
+    ] [ drop ] if ;
-: ripple-up? ( status word -- ? )
-    [
-        [ nip changed-effects get key? ]
-        [ "compiled-status" word-prop eq? not ] 2bi or
-    ] keep "compiled-status" word-prop and ;
-
-: save-compiled-status ( word status -- )
-    [ over ripple-up? [ ripple-up ] [ drop ] if ]
-    [ "compiled-status" set-word-prop ]
-    2bi ;
 
 : start ( word -- )
     "trace-compilation" get [ dup name>> print flush ] when
@@ -55,20 +46,19 @@ SYMBOLS: +optimized+ +unoptimized+ ;
 : ignore-error? ( word error -- ? )
     [
         {
-            [ inline? ]
             [ macro? ]
-            [ "no-compile" word-prop ]
+            [ inline? ]
             [ "special" word-prop ]
+            [ "no-compile" word-prop ]
         } 1||
     ] [ error-type +compiler-warning+ eq? ] bi* and ;
 
 : (fail) ( word compiled -- * )
     swap
+    [ recompile-callers ]
     [ compiled-unxref ]
     [ compiled get set-at ]
-    [ +unoptimized+ save-compiled-status ]
+    tri return ;
-    tri
-    return ;
 
 : not-compiled-def ( word error -- def )
     '[ _ _ not-compiled ] [ ] like ;
@@ -106,11 +96,10 @@ t compile-dependencies? set-global
     ] each ;
 
 : finish ( word -- )
-    [ +optimized+ save-compiled-status ]
+    [ recompile-callers ]
     [ compiled-unxref ]
     [
-        dup crossref?
+        dup crossref? [
-        [
             dependencies get
             generic-dependencies get
             compiled-xref

basis/macros/macros.factor

@@ -12,10 +12,11 @@ IN: macros
 PRIVATE>
 
 : define-macro ( word definition effect -- )
-    real-macro-effect
+    real-macro-effect {
-    [ [ memoize-quot [ call ] append ] keep define-declared ]
+        [ [ memoize-quot [ call ] append ] keep define-declared ]
-    [ drop "macro" set-word-prop ]
+        [ drop "macro" set-word-prop ]
-    3bi ;
+        [ 2drop changed-effect ]
+    } 3cleave ;
 
 SYNTAX: MACRO: (:) define-macro ;
 

basis/tools/deploy/shaker/shaker.factor

@@ -99,7 +99,6 @@ IN: tools.deploy.shaker
                 "boa-check"
                 "coercer"
                 "combination"
-                "compiled-status"
                 "compiled-generic-uses"
                 "compiled-uses"
                 "constraints"

core/definitions/definitions.factor

@@ -19,9 +19,6 @@ SYMBOL: changed-definitions
 
 SYMBOL: changed-effects
 
-: changed-effect ( word -- )
-    dup changed-effects get set-in-unit ;
-
 SYMBOL: changed-generics
 
 SYMBOL: outdated-generics

core/words/words.factor

@@ -138,12 +138,15 @@ M: word subwords drop f ;
     >>def
     dup crossref? [ dup xref ] when drop ;
 
+: changed-effect ( word -- )
+    [ dup changed-effects get set-in-unit ]
+    [ dup primitive? [ drop ] [ changed-definition ] if ] bi ;
+
 : set-stack-effect ( effect word -- )
     2dup "declared-effect" word-prop = [ 2drop ] [
-        swap
+        [ nip changed-effect ]
-        [ drop changed-effect ]
+        [ nip subwords [ changed-effect ] each ]
-        [ "declared-effect" set-word-prop ]
+        [ swap "declared-effect" set-word-prop ]
-        [ drop dup primitive? [ drop ] [ changed-definition ] if ]
         2tri
     ] if ;
 
@@ -151,7 +154,11 @@ M: word subwords drop f ;
     [ nip swap set-stack-effect ] [ drop define ] 3bi ;
 
 : make-inline ( word -- )
-    t "inline" set-word-prop ;
+    dup inline? [ drop ] [
+        [ t "inline" set-word-prop ]
+        [ changed-effect ]
+        bi
+    ] if ;
 
 : make-recursive ( word -- )
     t "recursive" set-word-prop ;