{ [ 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 ;
] unless
] unless ;
-: length-slots ( length class -- slots )
- "slots" word-prop length 1 - f <array>
- swap prefix ;
+: (slots-with-length) ( length class -- slots )
+ "slots" word-prop length 1 - f <array> swap prefix ;
+
+: slots-with-length ( seq -- slots )
+ [ length <literal-info> ] [ class ] bi (slots-with-length) ;
: init-literal-info ( info -- info )
empty-interval >>interval
dup literal>> {
{ [ dup real? ] [ [a,a] >>interval ] }
{ [ dup tuple? ] [ tuple-slot-infos >>slots ] }
- { [ dup fixed-length? ] [
- [ length <literal-info> ] [ class ] bi
- length-slots >>slots
- ] }
+ { [ dup fixed-length? ] [ slots-with-length >>slots ] }
[ drop ]
} cond ; inline
t >>literal?
init-value-info ; foldable
-: <sequence-info'> ( length class -- info )
+: <sequence-info> ( length class -- info )
<value-info>
over >>class
- [ length-slots ] dip swap >>slots
+ [ (slots-with-length) ] dip swap >>slots
init-value-info ;
: <tuple-info> ( slots class -- info )
: propagate-sequence-constructor ( #call word -- infos )
[ in-d>> first value-info ]
[ constructor-output-class ] bi*
- <sequence-info'> 1array ;
+ <sequence-info> 1array ;
: fold-<tuple-boa> ( values class -- info )
[ [ literal>> ] map ] dip prefix >tuple