From a9b4a724a41ca37eb21539dac9c3ccb3f536fabe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 21 Apr 2009 03:23:11 -0500
Subject: [PATCH] Remove "compiled-status" word prop and simplify associated
 machinery

---
 basis/compiler/compiler.factor          | 37 +++++++++----------------
 basis/macros/macros.factor              |  9 +++---
 basis/tools/deploy/shaker/shaker.factor |  1 -
 core/definitions/definitions.factor     |  3 --
 core/words/words.factor                 | 17 ++++++++----
 5 files changed, 30 insertions(+), 37 deletions(-)

diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index b8ba620f32..717f66ba88 100644
--- a/basis/compiler/compiler.factor
+++ b/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 -- )
-    dup "compiled-status" word-prop +unoptimized+ eq?
-    [ usage [ word? ] filter ] [ compiled-usage keys ] if
-    [ queue-compile ] each ;
-
-: 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 ;
+: recompile-callers ( words -- )
+    dup recompile-callers? [
+        [ usage [ word? ] filter ] [ compiled-usage keys ] bi
+        [ [ queue-compile ] each ] bi@
+    ] [ drop ] if ;
 
 : 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
diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor
index a86b711340..0e5ef30f51 100644
--- a/basis/macros/macros.factor
+++ b/basis/macros/macros.factor
@@ -12,10 +12,11 @@ IN: macros
 PRIVATE>
 
 : define-macro ( word definition effect -- )
-    real-macro-effect
-    [ [ memoize-quot [ call ] append ] keep define-declared ]
-    [ drop "macro" set-word-prop ]
-    3bi ;
+    real-macro-effect {
+        [ [ memoize-quot [ call ] append ] keep define-declared ]
+        [ drop "macro" set-word-prop ]
+        [ 2drop changed-effect ]
+    } 3cleave ;
 
 SYNTAX: MACRO: (:) define-macro ;
 
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 807abe4d58..0d7d8fd7c6 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/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"
diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor
index 7463a863e5..1a26e45e87 100644
--- a/core/definitions/definitions.factor
+++ b/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
diff --git a/core/words/words.factor b/core/words/words.factor
index 97225c0f75..1a2317997a 100755
--- a/core/words/words.factor
+++ b/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
-        [ drop changed-effect ]
-        [ "declared-effect" set-word-prop ]
-        [ drop dup primitive? [ drop ] [ changed-definition ] if ]
+        [ nip changed-effect ]
+        [ nip subwords [ changed-effect ] each ]
+        [ swap "declared-effect" set-word-prop ]
         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 ;