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 ;
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 ;
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 ;
: 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 )
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 )
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
] 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