]> gitweb.factorcode.org Git - factor.git/commitdiff
Optimizer cleanup
authorslava <slava@factorcode.org>
Wed, 10 May 2006 07:40:03 +0000 (07:40 +0000)
committerslava <slava@factorcode.org>
Wed, 10 May 2006 07:40:03 +0000 (07:40 +0000)
library/compiler/inference/dataflow.factor
library/compiler/optimizer/kill-literals.factor
library/generic/tuple.factor

index f50e1e1cb58cd25d199bd2e8f79c06b7f2ed4a09..f5404cd3f6df06c1da03318baa15d1a2ba152c94 100644 (file)
@@ -57,7 +57,7 @@ C: #call-label make-node ;
 
 TUPLE: #push ;
 C: #push make-node ;
-: #push ( -- node ) peek-d out-node <#push> ;
+: #push ( -- node ) peek-d 1array out-node <#push> ;
 : >#push< ( node -- seq ) node-out-d [ value-literal ] map ;
 
 TUPLE: #shuffle ;
@@ -77,11 +77,11 @@ C: #return make-node ;
 
 TUPLE: #if ;
 C: #if make-node ;
-: #if ( in -- node ) peek-d in-node <#if> ;
+: #if ( in -- node ) peek-d 1array in-node <#if> ;
 
 TUPLE: #dispatch ;
 C: #dispatch make-node ;
-: #dispatch ( in -- node ) peek-d in-node <#dispatch> ;
+: #dispatch ( in -- node ) peek-d 1array in-node <#dispatch> ;
 
 TUPLE: #merge ;
 C: #merge make-node ;
@@ -124,11 +124,6 @@ SYMBOL: current-node
         dup node-in-r % node-out-r %
     ] { } make ;
 
-: uses-value? ( value node -- ? ) node-values memq? ;
-
-: outputs-value? ( value node -- ? )
-    2dup node-out-d member? >r node-out-r member? r> or ;
-
 : last-node ( node -- last )
     dup node-successor [ last-node ] [ ] ?if ;
 
index 15aa355990e5a215b4c71199baa730a922a17250..fdb970950eda9fbe294750516af2464590fc01c8 100644 (file)
@@ -14,11 +14,6 @@ GENERIC: literals* ( node -- seq )
 : literals ( node -- hash )
     [ literals* ] node-union ;
 
-! GENERIC: flushable-values* ( node -- seq )
-! 
-! : flushable-values ( node -- hash )
-!     [ flushable-values* ] node-union ;
-
 GENERIC: live-values* ( node -- seq )
 
 : live-values ( node -- hash )
@@ -35,32 +30,17 @@ GENERIC: live-values* ( node -- seq )
     over hash-empty?
     [ 2drop ] [ [ kill-node* ] each-node-with ] if ;
 
-: kill-unused-literals ( node -- )
-    \ live-values get over literals hash-diff swap kill-node ;
-
 : kill-values ( node -- )
     dup live-values over literals hash-diff swap kill-node ;
 
 ! Generic nodes
 M: node literals* ( node -- ) drop { } ;
 
-! M: node flushable-values* ( node -- ) drop { } ;
-
-M: node live-values* ( node -- ) node-values ;
-
-! #shuffle
-M: #shuffle literals* ( node -- seq )
-    dup node-out-d swap node-out-r
-    [ [ value? ] subset ] 2apply append ;
+M: node live-values* ( node -- seq )
+    node-in-d [ value? ] subset ;
 
 ! #push
-M: #push literals* ( node -- seq )
-    node-values ;
-
-! #call
-! M: #call flushable-values* ( node -- )
-!     dup node-param "flushable" word-prop
-!     [ node-out-d ] [ drop { } ] if ;
+M: #push literals* ( node -- seq ) node-out-d ;
 
 ! #return
 M: #return live-values* ( node -- seq )
index 13ff6990a70ee14af7d695406a4a93cb956cd2ee..4a29fb6482f90acdfa4a05252e29a0f0ee6a2de4 100644 (file)
@@ -5,14 +5,11 @@ USING: arrays errors hashtables kernel kernel-internals lists
 math namespaces parser sequences sequences-internals strings
 vectors words ;
 
-: class ( object -- class )
-    dup tuple? [ 2 slot ] [ type type>class ] if ; inline
+IN: kernel-internals
 
 : class-tuple ( object -- class )
     dup tuple? [ 2 slot ] [ drop f ] if ; inline
 
-IN: kernel-internals
-
 : tuple= ( tuple tuple -- ? )
     2dup [ array-capacity ] 2apply number= [
         dup array-capacity
@@ -22,10 +19,14 @@ IN: kernel-internals
     ] if ; inline
 
 : tuple-hashcode ( n tuple -- n )
-    dup class hashcode >r >r 1- r> 4 slot hashcode* r> bitxor ;
+    dup class-tuple hashcode >r >r 1-
+    r> 4 slot hashcode* r> bitxor ;
 
 IN: generic
 
+: class ( object -- class )
+    dup tuple? [ 2 slot ] [ type type>class ] if ; inline
+
 : tuple-predicate ( word -- )
     dup predicate-word
     [ \ class-tuple , over literalize , \ eq? , ] [ ] make