From 0314d05a08311e574e8d9b427bd49206f11e01b4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 7 May 2008 07:49:36 -0500
Subject: [PATCH] Cleanup compiler

---
 core/compiler/compiler.factor           | 59 ++++++++++++++++---------
 core/inference/state/state-tests.factor |  4 ++
 core/inference/state/state.factor       |  4 --
 3 files changed, 42 insertions(+), 25 deletions(-)

diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor
index 806ea914bb..ef00e94dd5 100755
--- a/core/compiler/compiler.factor
+++ b/core/compiler/compiler.factor
@@ -4,38 +4,55 @@ USING: kernel namespaces arrays sequences io inference.backend
 inference.state generator debugger words compiler.units
 continuations vocabs assocs alien.compiler dlists optimizer
 definitions math compiler.errors threads graphs generic
-inference ;
+inference combinators ;
 IN: compiler
 
 : ripple-up ( word -- )
     compiled-usage [ drop queue-compile ] assoc-each ;
 
 : save-effect ( word effect -- )
-    over "compiled-uses" word-prop [
-        2dup swap "compiled-effect" word-prop =
-        [ over ripple-up ] unless
-    ] when
-    "compiled-effect" set-word-prop ;
-
-: finish-compile ( word effect dependencies -- )
-    >r dupd save-effect r>
-    over compiled-unxref
-    over compiled-crossref? [ compiled-xref ] [ 2drop ] if ;
-
-: compile-succeeded ( word -- effect dependencies )
     [
-        [ word-dataflow optimize ] keep dup generate
-    ] computing-dependencies ;
+        over "compiled-effect" word-prop = [
+            dup "compiled-uses" word-prop
+            [ dup ripple-up ] when
+        ] unless drop
+    ]
+    [ "compiled-effect" set-word-prop ] 2bi ;
+
+: compile-begins ( word -- )
+    f swap compiler-error ;
 
 : compile-failed ( word error -- )
-    f pick compiled get set-at
-    swap compiler-error ;
+    [ swap compiler-error ]
+    [
+        drop
+        [ f swap compiled get set-at ]
+        [ f save-effect ]
+        bi
+    ] 2bi ;
+
+: compile-succeeded ( effect word -- )
+    [ swap save-effect ]
+    [ compiled-unxref ]
+    [
+        dup compiled-crossref?
+        [ dependencies get compiled-xref ] [ drop ] if
+    ] tri ;
 
 : (compile) ( word -- )
-    f over compiler-error
-    [ dup compile-succeeded finish-compile ]
-    [ dupd compile-failed f save-effect ]
-    recover ;
+    [
+        H{ } clone dependencies set
+
+        {
+            [ compile-begins ]
+            [
+                [ word-dataflow ] [ compile-failed return ] recover
+                optimize
+            ]
+            [ dup generate ]
+            [ compile-succeeded ]
+        } cleave
+    ] curry with-return ;
 
 : compile-loop ( assoc -- )
     dup assoc-empty? [ drop ] [
diff --git a/core/inference/state/state-tests.factor b/core/inference/state/state-tests.factor
index 84d72bdd9b..fe1f51a5e7 100644
--- a/core/inference/state/state-tests.factor
+++ b/core/inference/state/state-tests.factor
@@ -1,6 +1,10 @@
 IN: inference.state.tests
 USING: tools.test inference.state words ;
 
+: computing-dependencies ( quot -- dependencies )
+    H{ } clone [ dependencies rot with-variable ] keep ;
+    inline
+
 SYMBOL: a
 SYMBOL: b
 
diff --git a/core/inference/state/state.factor b/core/inference/state/state.factor
index a426f410e2..6f0eecf2d9 100755
--- a/core/inference/state/state.factor
+++ b/core/inference/state/state.factor
@@ -36,10 +36,6 @@ SYMBOL: dependencies
         2dup at +inlined+ eq? [ 3drop ] [ set-at ] if
     ] [ 3drop ] if ;
 
-: computing-dependencies ( quot -- dependencies )
-    H{ } clone [ dependencies rot with-variable ] keep ;
-    inline
-
 ! Did the current control-flow path throw an error?
 SYMBOL: terminated?