From fd8136786bbe0ee38b67404b2fabbddc4efd6a02 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 22 Aug 2008 18:09:48 -0500
Subject: [PATCH] Cleaning up DCE
---
.../tree/cleanup/cleanup-tests.factor | 4 +--
.../tree/dead-code/branches/branches.factor | 4 +--
.../tree/dead-code/recursive/recursive.factor | 36 ++++++++++---------
.../tree/dead-code/simple/simple.factor | 30 ++++++++++------
basis/compiler/tree/debugger/debugger.factor | 2 +-
5 files changed, 43 insertions(+), 33 deletions(-)
diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index 3a645955c2..437112625c 100644
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -144,7 +144,7 @@ M: object xyz ;
[ f ] [ [ dup 0 < [ neg ] when ] \ - inlined? ] unit-test
-[ f ] [
+[ t ] [
[
[ no-cond ] 1
[ 1array dup quotation? [ >quotation ] unless ] times
@@ -433,7 +433,7 @@ cell-bits 32 = [
] { >= fixnum>= } inlined?
] unit-test
-[ t ] [
+[ ] [
[
4 pick array-capacity?
[ set-slot ] [ \ array-capacity 2nip bad-slot-value ] if
diff --git a/basis/compiler/tree/dead-code/branches/branches.factor b/basis/compiler/tree/dead-code/branches/branches.factor
index bbae02b4ff..0014a1d4d7 100644
--- a/basis/compiler/tree/dead-code/branches/branches.factor
+++ b/basis/compiler/tree/dead-code/branches/branches.factor
@@ -35,7 +35,7 @@ M: #branch remove-dead-code*
[ length ] keep live-values get
'[ , nth , key? ] filter ; inline
-: drop-values ( values indices -- node )
+: drop-indexed-values ( values indices -- node )
[ drop filter-live ] [ nths ] 2bi
[ make-values ] keep
[ drop ] [ zip ] 2bi
@@ -44,7 +44,7 @@ M: #branch remove-dead-code*
: insert-drops ( nodes values indices -- nodes' )
'[
over ends-with-terminate?
- [ drop ] [ , drop-values suffix ] if
+ [ drop ] [ , drop-indexed-values suffix ] if
] 2map ;
: hoist-drops ( #phi -- )
diff --git a/basis/compiler/tree/dead-code/recursive/recursive.factor b/basis/compiler/tree/dead-code/recursive/recursive.factor
index 022912ff4e..4c6b411430 100644
--- a/basis/compiler/tree/dead-code/recursive/recursive.factor
+++ b/basis/compiler/tree/dead-code/recursive/recursive.factor
@@ -25,14 +25,13 @@ M: #call-recursive compute-live-values*
[ out-d>> ] [ label>> return>> in-d>> ] bi look-at-mapping ;
:: drop-dead-inputs ( inputs outputs -- #shuffle )
- [let* | new-inputs [ inputs make-values ]
- live-inputs [ outputs inputs filter-corresponding ]
- new-live-inputs [ outputs new-inputs filter-corresponding ]
- mapping [ new-live-inputs live-inputs zip ] |
- inputs filter-live
+ [let* | live-inputs [ inputs filter-live ]
+ new-live-inputs [ outputs inputs filter-corresponding make-values ] |
+ live-inputs
new-live-inputs
- mapping
- #shuffle
+ outputs
+ inputs
+ drop-values
] ;
M: #recursive remove-dead-code* ( node -- nodes )
@@ -53,18 +52,21 @@ M: #enter-recursive remove-dead-code*
[ nip ]
2bi ;
-:: drop-call-recursive-outputs ( node -- #shuffle )
- [let* | node-out [ node out-d>> ]
- return-in [ node label>> return>> in-d>> ]
- node-out-live [ return-in node-out filter-corresponding ]
- new-node-out-live [ node-out-live make-values ]
- node-out-dropped [ node-out filter-live ]
- new-node-out-dropped [ node-out-dropped new-node-out-live filter-corresponding ]
- mapping [ node-out-dropped new-node-out-dropped zip ] |
- node new-node-out-live >>out-d drop
- new-node-out-live node-out-dropped mapping #shuffle
+:: (drop-call-recursive-outputs) ( inputs outputs -- #shuffle )
+ [let* | new-live-outputs [ inputs outputs filter-corresponding make-values ]
+ live-outputs [ outputs filter-live ] |
+ new-live-outputs
+ live-outputs
+ live-outputs
+ new-live-outputs
+ drop-values
] ;
+: drop-call-recursive-outputs ( node -- #shuffle )
+ dup [ label>> return>> in-d>> ] [ out-d>> ] bi
+ (drop-call-recursive-outputs)
+ [ in-d>> >>out-d drop ] keep ;
+
M: #call-recursive remove-dead-code*
[ drop-call-recursive-inputs ]
[ ]
diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor
index 01c535a819..f1be869295 100644
--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/basis/compiler/tree/dead-code/simple/simple.factor
@@ -61,20 +61,28 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
: filter-live ( values -- values' )
[ live-value? ] filter ;
-: drop-dead-values ( in out -- #shuffle )
- [ make-values dup ] keep zip #shuffle ;
+:: drop-values ( inputs outputs mapping-keys mapping-values -- #shuffle )
+ inputs
+ outputs
+ outputs
+ mapping-keys
+ mapping-values
+ filter-corresponding zip #shuffle ; inline
-:: drop-dead-outputs ( node -- nodes )
- [let* | old-outputs [ node out-d>> ]
- new-outputs [ old-outputs make-values ]
- old-live-outputs [ old-outputs filter-live ]
- new-live-outputs [ old-outputs new-outputs filter-corresponding ]
- mapping [ old-live-outputs new-live-outputs zip ] |
- node new-outputs >>out-d
- new-outputs old-live-outputs mapping #shuffle
- 2array
+:: drop-dead-values ( outputs -- #shuffle )
+ [let* | new-outputs [ outputs make-values ]
+ live-outputs [ outputs filter-live ] |
+ new-outputs
+ live-outputs
+ outputs
+ new-outputs
+ drop-values
] ;
+: drop-dead-outputs ( node -- nodes )
+ dup out-d>> drop-dead-values
+ [ in-d>> >>out-d drop ] [ 2array ] 2bi ;
+
M: #introduce remove-dead-code* ( #introduce -- nodes )
drop-dead-outputs ;
diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index 7660ec3222..db742197a5 100644
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -3,7 +3,7 @@
USING: kernel assocs fry match accessors namespaces effects
sequences sequences.private quotations generic macros arrays
prettyprint prettyprint.backend prettyprint.sections math words
-combinators io sorting
+combinators io sorting hints
compiler.tree
compiler.tree.builder
compiler.tree.optimizer