compiler.tree.cleanup: more docs and a test

basis/compiler/tree/cleanup/cleanup-docs.factor

@@ -13,14 +13,23 @@ HELP: cleanup-tree
 { $values { "nodes" sequence } { "nodes'" sequence } }
 { $description "Main entry point for the cleanup-tree optimization phase. We don't recurse into children here, instead the methods do it since the logic is a bit more involved." } ;
 
+HELP: (cleanup-folding)
+{ $values { "#call" #call } { "nodes" sequence } }
+{ $description "Replace a #call having a known result with a #drop of its inputs followed by #push nodes for the outputs." } ;
+
+HELP: flatten-recursive
+{ $values { "#recursive" #recursive } { "nodes" sequence } }
+{ $description "Converts " { $link #enter-recursive } " and " { $link #return-recursive } " into " { $link #copy } " nodes." } ;
+
 HELP: fold-only-branch
 { $values { "#branch" #branch } { "node/nodes" "a " { $link node } " or a sequence of nodes" } }
 { $description "If only one branch is live we don't need to branch at all; just drop the condition value." } ;
 
 ARTICLE: "compiler.tree.cleanup" "Cleanup Phase"
-"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."
+"A phase run after propagation to finish the job, so to speak. Codifies speculative inlining decisions, deletes branches marked as never taken, replaces folded calls with constants and flattens local recursive blocks that do not call themselves."
 $nl
 "Main entry point:"
-{ $subsections cleanup-tree } ;
+{ $subsections cleanup-tree }
+"Each node type implements its own method on the " { $link cleanup-tree* } " generic." ;
 
 ABOUT: "compiler.tree.cleanup"

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

@@ -541,3 +541,44 @@ cell-bits 32 = [
     [ void { } cdecl [ ] alien-callback void { } cdecl alien-indirect ]
     \ >c-ptr inlined?
 ] unit-test
+
+! cleanup-folding
+: call-node-foldable ( -- node )
+    T{ #call
+       { word set-slot }
+       { in-d V{ 1 2 } }
+       { out-d V{ 3 } }
+       { info
+         H{
+             {
+                 1
+                 T{ value-info-state
+                    { class fixnum }
+                    { literal 2 }
+                    { literal? t }
+                 }
+             }
+             {
+                 2
+                 T{ value-info-state
+                    { class fixnum }
+                    { literal 3 }
+                    { literal? t }
+                 }
+             }
+             {
+                 3
+                 T{ value-info-state
+                    { class fixnum }
+                    { literal 5 }
+                    { literal? t }
+                 }
+             }
+         }
+       }
+    } ;
+
+{ t t } [
+    call-node-foldable cleanup-folding
+    [ length 2 = ] [ last literal>> 5 = ] bi
+] unit-test

basis/compiler/tree/cleanup/cleanup.factor

@@ -1,12 +1,10 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes classes.algebra combinators
+USING: accessors classes classes.algebra combinators compiler.tree
-compiler.tree compiler.tree.combinators
+compiler.tree.combinators compiler.tree.propagation.branches
-compiler.tree.propagation.branches
+compiler.tree.propagation.info compiler.utilities fry kernel layouts
-compiler.tree.propagation.info compiler.utilities fry kernel
+math math.intervals math.partial-dispatch math.private namespaces
-layouts math math.intervals math.partial-dispatch math.private
+sequences stack-checker.branches stack-checker.dependencies words ;
-namespaces sequences stack-checker.branches
-stack-checker.dependencies words ;
 IN: compiler.tree.cleanup
 
 GENERIC: delete-node ( node -- )
@@ -32,8 +30,6 @@ GENERIC: cleanup-tree* ( node -- node/nodes )
     [ f ] [ [ literal?>> ] all? ] if-empty ;
 
 : (cleanup-folding) ( #call -- nodes )
-    ! Replace a #call having a known result with a #drop of its
-    ! inputs followed by #push nodes for the outputs.
     [
         [ node-output-infos ] [ out-d>> ] bi
         [ [ literal>> ] dip <#push> ] 2map
@@ -87,7 +83,10 @@ GENERIC: cleanup-tree* ( node -- node/nodes )
 
 : remove-overflow-check? ( #call -- ? )
     {
-        { [ dup word>> \ fixnum-shift eq? ] [ [ (remove-overflow-check?) ] [ small-shift? ] bi and ] }
+        {
+            [ dup word>> \ fixnum-shift eq? ]
+            [ [ (remove-overflow-check?) ] [ small-shift? ] bi and ]
+        }
         { [ dup word>> no-overflow-variant ] [ (remove-overflow-check?) ] }
         [ drop f ]
     } cond ;
@@ -159,8 +158,6 @@ M: #phi cleanup-tree*
 : >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi <#copy> ;
 
 : flatten-recursive ( #recursive -- nodes )
-    ! convert #enter-recursive and #return-recursive into
-    ! #copy nodes.
     child>>
     unclip >copy prefix
     unclip-last >copy suffix ;