use reject instead of [ ... not ] filter.

[factor.git] / basis / compiler / tree / cleanup / cleanup.factor

diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor
index b19c99c360af784109c4a273d165781e9ed51e5d..d610ef17650b2a21994facd2b490f71f6011472f 100644 (file)
--- a/basis/compiler/tree/cleanup/cleanup.factor
+++ b/basis/compiler/tree/cleanup/cleanup.factor
@@ -1,26 +1,18 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences combinators fry
-classes.algebra namespaces assocs words math math.private
-math.partial-dispatch math.intervals classes classes.tuple
-classes.tuple.private layouts definitions stack-checker.dependencies
-stack-checker.branches
-compiler.utilities
-compiler.tree
-compiler.tree.combinators
-compiler.tree.propagation.info
-compiler.tree.propagation.branches ;
+USING: accessors classes classes.algebra combinators
+compiler.tree compiler.tree.combinators
+compiler.tree.propagation.branches
+compiler.tree.propagation.info compiler.utilities fry kernel
+layouts math math.intervals math.partial-dispatch math.private
+namespaces sequences stack-checker.branches
+stack-checker.dependencies words ;
 IN: compiler.tree.cleanup
 
-! A phase run after propagation to finish the job, so to speak.
-! Codifies speculative inlining decisions, deletes branches
-! marked as never taken, and flattens local recursive blocks
-! that do not call themselves.
-
 GENERIC: delete-node ( node -- )
 
 M: #call-recursive delete-node
-    dup label>> calls>> [ node>> eq? not ] with filter! drop ;
+    dup label>> calls>> [ node>> eq? ] with reject! drop ;
 
 M: #return-recursive delete-node
     label>> f >>return drop ;
@@ -46,21 +38,26 @@ GENERIC: cleanup* ( node -- node/nodes )
     #! inputs followed by #push nodes for the outputs.
     [
         [ node-output-infos ] [ out-d>> ] bi
-        [ [ literal>> ] dip #push ] 2map
+        [ [ literal>> ] dip <#push> ] 2map
     ]
-    [ in-d>> #drop ]
+    [ in-d>> <#drop> ]
     bi prefix ;
 
-: record-predicate-folding ( #call -- )
-    [ node-input-infos first class>> ]
+: >predicate-folding< ( #call -- value-info class result )
+    [ node-input-infos first ]
     [ word>> "predicating" word-prop ]
-    [ node-output-infos first literal>> ] tri
-    [ depends-on-class<= ] [ depends-on-classes-disjoint ] if ;
+    [ node-output-infos first literal>> ] tri ;
+
+: record-predicate-folding ( #call -- )
+    >predicate-folding< pick literal?>>
+    [ [ literal>> ] 2dip add-depends-on-instance-predicate ]
+    [ [ class>> ] 2dip add-depends-on-class-predicate ]
+    if ;
 
 : record-folding ( #call -- )
     dup word>> predicate?
     [ record-predicate-folding ]
-    [ word>> depends-on-definition ]
+    [ word>> add-depends-on-definition ]
     if ;
 
 : cleanup-folding ( #call -- nodes )
@@ -69,15 +66,15 @@ GENERIC: cleanup* ( node -- node/nodes )
 ! Method inlining
 : add-method-dependency ( #call -- )
     dup method>> word? [
-        [ [ class>> ] [ word>> ] bi depends-on-generic ]
-        [ [ class>> ] [ word>> ] [ method>> ] tri depends-on-method ]
+        [ [ class>> ] [ word>> ] bi add-depends-on-generic ]
+        [ [ class>> ] [ word>> ] [ method>> ] tri add-depends-on-method ]
         bi
     ] [ drop ] if ;
 
 : record-inlining ( #call -- )
     dup method>>
     [ add-method-dependency ]
-    [ word>> depends-on-definition ] if ;
+    [ word>> add-depends-on-definition ] if ;
 
 : cleanup-inlining ( #call -- nodes )
     [ record-inlining ] [ body>> cleanup ] bi ;
@@ -120,8 +117,8 @@ M: #call cleanup*
     #! If only one branch is live we don't need to branch at
     #! all; just drop the condition value.
     dup live-children sift dup length {
-        { 0 [ drop in-d>> #drop ] }
-        { 1 [ first swap in-d>> #drop prefix ] }
+        { 0 [ drop in-d>> <#drop> ] }
+        { 1 [ first swap in-d>> <#drop> prefix ] }
         [ 2drop ]
     } case ;
 
@@ -139,12 +136,12 @@ M: #branch cleanup*
     } cleave ;
 
 : output-fs ( values -- nodes )
-    [ f swap #push ] map ;
+    [ f swap <#push> ] map ;
 
 : eliminate-single-phi ( #phi -- node )
     [ phi-in-d>> first ] [ out-d>> ] bi over [ +bottom+ eq? ] all?
     [ [ drop ] [ output-fs ] bi* ]
-    [ #copy ]
+    [ <#copy> ]
     if ;
 
 : eliminate-phi ( #phi -- node )
@@ -163,7 +160,7 @@ M: #phi cleanup*
     eliminate-phi
     live-branches off ;
 
-: >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi #copy ;
+: >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi <#copy> ;
 
 : flatten-recursive ( #recursive -- nodes )
     #! convert #enter-recursive and #return-recursive into
@@ -177,4 +174,7 @@ M: #recursive cleanup*
     [ cleanup ] change-child
     dup label>> calls>> empty? [ flatten-recursive ] when ;
 
+M: #alien-callback cleanup*
+    [ cleanup ] change-child ;
+
 M: node cleanup* ;