diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index b154845c07..22ea1306d6 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -47,9 +47,7 @@ CONSTANT: object-info T{ value-info f object full-interval } { [ over interval-length 0 > ] [ 3drop f f ] } { [ pick bignum class<= ] [ 2nip >bignum t ] } { [ pick integer class<= ] [ 2nip >fixnum t ] } - { [ pick float class<= ] [ - 2nip dup zero? [ drop f f ] [ >float t ] if - ] } + { [ pick float class<= ] [ 2nip dup zero? [ drop f f ] [ >float t ] if ] } [ 3drop f f ] } cond ] if ; @@ -73,9 +71,11 @@ UNION: fixed-length array byte-array string ; ] unless ] unless ; -: length-slots ( length class -- slots ) - "slots" word-prop length 1 - f - swap prefix ; +: (slots-with-length) ( length class -- slots ) + "slots" word-prop length 1 - f swap prefix ; + +: slots-with-length ( seq -- slots ) + [ length ] [ class ] bi (slots-with-length) ; : init-literal-info ( info -- info ) empty-interval >>interval @@ -83,10 +83,7 @@ UNION: fixed-length array byte-array string ; dup literal>> { { [ dup real? ] [ [a,a] >>interval ] } { [ dup tuple? ] [ tuple-slot-infos >>slots ] } - { [ dup fixed-length? ] [ - [ length ] [ class ] bi - length-slots >>slots - ] } + { [ dup fixed-length? ] [ slots-with-length >>slots ] } [ drop ] } cond ; inline @@ -164,10 +161,10 @@ UNION: fixed-length array byte-array string ; t >>literal? init-value-info ; foldable -: ( length class -- info ) +: ( length class -- info ) over >>class - [ length-slots ] dip swap >>slots + [ (slots-with-length) ] dip swap >>slots init-value-info ; : ( slots class -- info ) diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor index 6429928294..2602d6d59a 100644 --- a/basis/compiler/tree/propagation/slots/slots.factor +++ b/basis/compiler/tree/propagation/slots/slots.factor @@ -23,7 +23,7 @@ IN: compiler.tree.propagation.slots : propagate-sequence-constructor ( #call word -- infos ) [ in-d>> first value-info ] [ constructor-output-class ] bi* - 1array ; + 1array ; : fold- ( values class -- info ) [ [ literal>> ] map ] dip prefix >tuple