From b5754d32ef9e8dc2432c67c00768adc028350429 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Sun, 9 Nov 2014 02:02:48 +0100
Subject: [PATCH] compiler.cfg.dependence: moved tree verification code to
 .tests

Since verify-trees just checked that make-trees worked correctly, it's
better to have that code in the test vocab instead of slowing down
every compile by running it
---
 .../cfg/dependence/dependence-tests.factor    | 26 +++++++++++++++--
 .../compiler/cfg/dependence/dependence.factor | 29 +++----------------
 2 files changed, 27 insertions(+), 28 deletions(-)

diff --git a/basis/compiler/cfg/dependence/dependence-tests.factor b/basis/compiler/cfg/dependence/dependence-tests.factor
index b9e9a67ae3..d8fdedfc61 100644
--- a/basis/compiler/cfg/dependence/dependence-tests.factor
+++ b/basis/compiler/cfg/dependence/dependence-tests.factor
@@ -1,6 +1,7 @@
-USING: accessors arrays compiler.cfg.dependence compiler.cfg.instructions
-kernel namespaces sequences tools.test ;
+USING: accessors arrays combinators.short-circuit compiler.cfg.dependence
+compiler.cfg.instructions fry kernel namespaces sequences tools.test ;
 IN: compiler.cfg.dependence.tests
+FROM: sets => set= ;
 
 {
     V{
@@ -35,13 +36,32 @@ IN: compiler.cfg.dependence.tests
     3 iota [ node new swap >>number ] map first3
     over attach-parent over attach-parent ;
 
+
+! Verification tests
+ERROR: node-missing-parent trees nodes ;
+ERROR: node-missing-children trees nodes ;
+
+: flatten-tree ( node -- nodes )
+    [ children>> [ flatten-tree ] map concat ] keep suffix ;
+
+: verify-parents ( nodes trees -- )
+    2dup '[ [ parent>> ] [ _ member? ] bi or ] all?
+    [ 2drop ] [ node-missing-parent ] if ;
+
+: verify-children ( nodes trees -- )
+    2dup [ flatten-tree ] map concat
+    { [ [ length ] same? ] [ set= ] } 2&&
+    [ 2drop ] [ node-missing-children ] if ;
+
+: verify-trees ( nodes trees -- )
+    [ verify-parents ] [ verify-children ] 2bi ;
+
 { } [ 2node-tree 1array dup verify-parents ] unit-test
 
 [
     2node-tree 1array { } verify-parents
 ] [ node-missing-parent? ] must-fail-with
 
-
 { 1 } [ 3node-tree children>> length ] unit-test
 
 { 3 } [ 3node-tree flatten-tree length ] unit-test
diff --git a/basis/compiler/cfg/dependence/dependence.factor b/basis/compiler/cfg/dependence/dependence.factor
index 9e0aca0f46..eaddd89133 100644
--- a/basis/compiler/cfg/dependence/dependence.factor
+++ b/basis/compiler/cfg/dependence/dependence.factor
@@ -1,9 +1,8 @@
 ! Copyright (C) 2009, 2010 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators compiler.cfg.def-use
-compiler.cfg.instructions compiler.cfg.registers fry kernel
-locals namespaces sequences sets sorting math.vectors
-make math combinators.short-circuit vectors ;
+compiler.cfg.instructions compiler.cfg.registers fry kernel locals
+namespaces sequences sorting make math math.vectors vectors ;
 FROM: namespaces => set ;
 IN: compiler.cfg.dependence
 
@@ -102,10 +101,8 @@ M: object add-control-edge 2drop ;
     dup node registers<< ;
 
 ! Constructing fan-in trees
-
 : attach-parent ( node parent -- )
-    [ >>parent drop ]
-    [ [ ?push ] change-children drop ] 2bi ;
+    [ >>parent drop ] [ [ ?push ] change-children drop ] 2bi ;
 
 : keys-for ( assoc value -- keys )
     '[ nip _ = ] assoc-filter keys ;
@@ -122,26 +119,8 @@ M: object add-control-edge 2drop ;
 : make-trees ( nodes -- trees )
     [ [ choose-parent ] each ] [ [ parent>> not ] filter ] bi ;
 
-ERROR: node-missing-parent trees nodes ;
-ERROR: node-missing-children trees nodes ;
-
-: flatten-tree ( node -- nodes )
-    [ children>> [ flatten-tree ] map concat ] keep suffix ;
-
-: verify-parents ( nodes trees -- )
-    2dup '[ [ parent>> ] [ _ member? ] bi or ] all?
-    [ 2drop ] [ node-missing-parent ] if ;
-
-: verify-children ( nodes trees -- )
-    2dup [ flatten-tree ] map concat
-    { [ [ length ] same? ] [ set= ] } 2&&
-    [ 2drop ] [ node-missing-children ] if ;
-
-: verify-trees ( nodes trees -- )
-    [ verify-parents ] [ verify-children ] 2bi ;
-
 : build-fan-in-trees ( nodes -- )
-    dup make-trees [ verify-trees ] keep [
+    make-trees [
         -1/0. >>parent-index
         calculate-registers drop
     ] each ;