diff --git a/library/compiler/inference/dataflow.factor b/library/compiler/inference/dataflow.factor index f50e1e1cb5..f5404cd3f6 100644 --- a/library/compiler/inference/dataflow.factor +++ b/library/compiler/inference/dataflow.factor @@ -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 ; diff --git a/library/compiler/optimizer/kill-literals.factor b/library/compiler/optimizer/kill-literals.factor index 15aa355990..fdb970950e 100644 --- a/library/compiler/optimizer/kill-literals.factor +++ b/library/compiler/optimizer/kill-literals.factor @@ -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 ) diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 13ff6990a7..4a29fb6482 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -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