Don't keep compiled-effect around anymore

basis/compiler/cfg/debugger/debugger.factor

@@ -16,7 +16,7 @@ M: callable test-cfg
     build-tree optimize-tree gensym build-cfg ;
 
 M: word test-cfg
-    [ build-tree-from-word nip optimize-tree ] keep build-cfg ;
+    [ build-tree-from-word optimize-tree ] keep build-cfg ;
 
 SYMBOL: allocate-registers?
 

basis/compiler/compiler.factor

@@ -1,46 +1,47 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces arrays sequences io
-words fry continuations vocabs assocs dlists definitions math
-graphs generic combinators deques search-deques io
-stack-checker stack-checker.state stack-checker.inlining
-compiler.errors compiler.units compiler.tree.builder
-compiler.tree.optimizer compiler.cfg.builder
-compiler.cfg.optimizer compiler.cfg.linearization
-compiler.cfg.two-operand compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
+USING: accessors kernel namespaces arrays sequences io words fry
+continuations vocabs assocs dlists definitions math graphs
+generic combinators deques search-deques io stack-checker
+stack-checker.state stack-checker.inlining
+combinators.short-circuit compiler.errors compiler.units
+compiler.tree.builder compiler.tree.optimizer
+compiler.cfg.builder compiler.cfg.optimizer
+compiler.cfg.linearization compiler.cfg.two-operand
+compiler.cfg.linear-scan compiler.cfg.stack-frame
+compiler.codegen compiler.utilities ;
 IN: compiler
 
 SYMBOL: compile-queue
 SYMBOL: compiled
 
-: queue-compile ( word -- )
+: queue-compile? ( word -- ? )
     {
-        { [ dup "forgotten" word-prop ] [ ] }
-        { [ dup compiled get key? ] [ ] }
-        { [ dup inlined-block? ] [ ] }
-        { [ dup primitive? ] [ ] }
-        [ dup compile-queue get push-front ]
-    } cond drop ;
+        [ "forgotten" word-prop ]
+        [ compiled get key? ]
+        [ inlined-block? ]
+        [ primitive? ]
+    } 1|| not ;
+
+: queue-compile ( word -- )
+    dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
 
 : maybe-compile ( word -- )
     dup optimized>> [ drop ] [ queue-compile ] if ;
 
-SYMBOL: +failed+
+SYMBOLS: +optimized+ +unoptimized+ ;
 
 : ripple-up ( words -- )
-    dup "compiled-effect" word-prop +failed+ eq?
+    dup "compiled-status" word-prop +unoptimized+ eq?
     [ usage [ word? ] filter ] [ compiled-usage keys ] if
     [ queue-compile ] each ;
 
-: ripple-up? ( word effect -- ? )
-    #! If the word has previously been compiled and had a
-    #! different stack effect, we have to recompile any callers.
-    swap "compiled-effect" word-prop [ = not ] keep and ;
+: ripple-up? ( word status -- ? )
+    swap "compiled-status" word-prop [ = not ] keep and ;
 
-: save-effect ( word effect -- )
+: save-compiled-status ( word status -- )
     [ dupd ripple-up? [ ripple-up ] [ drop ] if ]
-    [ "compiled-effect" set-word-prop ]
+    [ "compiled-status" set-word-prop ]
     2bi ;
 
 : start ( word -- )
@@ -49,18 +50,18 @@ SYMBOL: +failed+
     H{ } clone generic-dependencies set
     f swap compiler-error ;
 
-: fail ( word error -- )
+: fail ( word error -- * )
     [ swap compiler-error ]
     [
         drop
         [ compiled-unxref ]
         [ f swap compiled get set-at ]
-        [ +failed+ save-effect ]
+        [ +unoptimized+ save-compiled-status ]
         tri
     ] 2bi
     return ;
 
-: frontend ( word -- effect nodes )
+: frontend ( word -- nodes )
     [ build-tree-from-word ] [ fail ] recover optimize-tree ;
 
 ! Only switch this off for debugging.
@@ -84,8 +85,8 @@ t compile-dependencies? set-global
         save-asm
     ] each ;
 
-: finish ( effect word -- )
-    [ swap save-effect ]
+: finish ( word -- )
+    [ +optimized+ save-compiled-status ]
     [ compiled-unxref ]
     [
         dup crossref?
@@ -112,6 +113,9 @@ t compile-dependencies? set-global
 : decompile ( word -- )
     f 2array 1array modify-code-heap ;
 
+: compile-call ( quot -- )
+    [ dup infer define-temp ] with-compilation-unit execute ;
+
 : optimized-recompile-hook ( words -- alist )
     [
         <hashed-dlist> compile-queue set

basis/compiler/tests/optimizer.factor

@@ -303,7 +303,7 @@ HINTS: recursive-inline-hang-3 array ;
 : member-test ( obj -- ? ) { + - * / /i } member? ;
 
 \ member-test must-infer
-[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test
+[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
 [ t ] [ \ + member-test ] unit-test
 [ f ] [ \ append member-test ] unit-test
 

basis/compiler/tree/builder/builder-tests.factor

@@ -8,4 +8,4 @@ compiler.tree ;
 
 : inline-recursive ( -- ) inline-recursive ; inline recursive
 
-[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test
+[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test

basis/compiler/tree/builder/builder.factor

@@ -12,18 +12,18 @@ IN: compiler.tree.builder
 
 : with-tree-builder ( quot -- nodes )
     '[ V{ } clone stack-visitor set @ ]
-    with-infer ; inline
+    with-infer nip ; inline
 
 : build-tree ( quot -- nodes )
     #! Not safe to call from inference transforms.
-    [ f initial-recursive-state infer-quot ] with-tree-builder nip ;
+    [ f initial-recursive-state infer-quot ] with-tree-builder ;
 
 : build-tree-with ( in-stack quot -- nodes out-stack )
     #! Not safe to call from inference transforms.
     [
         [ >vector \ meta-d set ]
         [ f initial-recursive-state infer-quot ] bi*
-    ] with-tree-builder nip
+    ] with-tree-builder
     unclip-last in-d>> ;
 
 : build-sub-tree ( #call quot -- nodes )
@@ -45,7 +45,7 @@ IN: compiler.tree.builder
 : check-no-compile ( word -- )
     dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ;
 
-: build-tree-from-word ( word -- effect nodes )
+: build-tree-from-word ( word -- nodes )
     [
         [
             {

basis/compiler/tree/debugger/debugger.factor

@@ -144,7 +144,7 @@ SYMBOL: node-count
 
 : make-report ( word/quot -- assoc )
     [
-        dup word? [ build-tree-from-word nip ] [ build-tree ] if
+        dup word? [ build-tree-from-word ] [ build-tree ] if
         optimize-tree
 
         H{ } clone words-called set