diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor index 60b9af0f19..c0ac29f99b 100755 --- a/basis/struct-arrays/struct-arrays.factor +++ b/basis/struct-arrays/struct-arrays.factor @@ -4,10 +4,14 @@ USING: accessors alien alien.c-types byte-arrays kernel libc math sequences sequences.private ; IN: struct-arrays +: c-type-struct-class ( c-type -- class ) + c-type boxed-class>> ; foldable + TUPLE: struct-array { underlying c-ptr read-only } { length array-capacity read-only } -{ element-size array-capacity read-only } ; +{ element-size array-capacity read-only } +{ class read-only } ; M: struct-array length length>> ; M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; @@ -19,25 +23,28 @@ M: struct-array set-nth-unsafe [ nth-unsafe swap ] [ element-size>> ] bi memcpy ; M: struct-array new-sequence - element-size>> [ * ] 2keep struct-array boa ; inline + [ element-size>> [ * ] 2keep ] + [ class>> ] bi struct-array boa ; inline M: struct-array resize ( n seq -- newseq ) - [ [ element-size>> * ] [ underlying>> ] bi resize ] [ element-size>> ] 2bi + [ [ element-size>> * ] [ underlying>> ] bi resize ] + [ [ element-size>> ] [ class>> ] bi ] 2bi struct-array boa ; : ( length c-type -- struct-array ) - heap-size [ * ] 2keep struct-array boa ; inline + [ heap-size [ * ] 2keep ] + [ c-type-struct-class ] bi struct-array boa ; inline ERROR: bad-byte-array-length byte-array ; : byte-array>struct-array ( byte-array c-type -- struct-array ) - heap-size [ + [ heap-size [ [ dup length ] dip /mod 0 = [ drop bad-byte-array-length ] unless - ] keep struct-array boa ; inline + ] keep ] [ c-type-struct-class ] bi struct-array boa ; inline : ( alien length c-type -- struct-array ) - heap-size struct-array boa ; inline + [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline : malloc-struct-array ( length c-type -- struct-array ) [ heap-size calloc ] 2keep ; inline