factor/basis/struct-arrays/struct-arrays.factor

67 lines
2.2 KiB
Factor
Raw Normal View History

2008-12-03 10:41:48 -05:00
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.structs byte-arrays
classes.struct kernel libc math sequences sequences.private ;
2008-12-03 10:41:48 -05:00
IN: struct-arrays
2009-08-26 14:13:19 -04:00
: c-type-struct-class ( c-type -- class )
c-type boxed-class>> ; foldable
2008-12-03 10:41:48 -05:00
TUPLE: struct-array
{ underlying c-ptr read-only }
{ length array-capacity read-only }
2009-08-26 14:13:19 -04:00
{ element-size array-capacity read-only }
{ class read-only } ;
2008-12-03 10:41:48 -05:00
M: struct-array length length>> ;
2009-07-07 16:11:04 -04:00
M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ;
2008-12-03 10:41:48 -05:00
: (nth-ptr) ( i struct-array -- alien )
[ element-size>> * ] [ underlying>> ] bi <displaced-alien> ; inline
2008-12-03 10:41:48 -05:00
M: struct-array nth-unsafe
[ (nth-ptr) ] [ class>> ] bi [ memory>struct ] when* ; inline
2008-12-03 10:41:48 -05:00
M: struct-array set-nth-unsafe
[ (nth-ptr) swap ] [ element-size>> ] bi memcpy ;
2008-12-03 10:41:48 -05:00
M: struct-array new-sequence
2009-08-26 14:13:19 -04:00
[ element-size>> [ * <byte-array> ] 2keep ]
[ class>> ] bi struct-array boa ; inline
2008-12-03 10:41:48 -05:00
M: struct-array resize ( n seq -- newseq )
2009-08-26 14:13:19 -04:00
[ [ element-size>> * ] [ underlying>> ] bi resize ]
[ [ element-size>> ] [ class>> ] bi ] 2bi
struct-array boa ;
2008-12-03 10:41:48 -05:00
: <struct-array> ( length c-type -- struct-array )
2009-08-26 14:13:19 -04:00
[ heap-size [ * <byte-array> ] 2keep ]
[ c-type-struct-class ] bi struct-array boa ; inline
2008-12-03 10:41:48 -05:00
ERROR: bad-byte-array-length byte-array ;
: byte-array>struct-array ( byte-array c-type -- struct-array )
2009-08-26 14:13:19 -04:00
[ heap-size [
2008-12-03 10:41:48 -05:00
[ dup length ] dip /mod 0 =
[ drop bad-byte-array-length ] unless
2009-08-26 14:13:19 -04:00
] keep ] [ c-type-struct-class ] bi struct-array boa ; inline
2008-12-03 10:41:48 -05:00
: <direct-struct-array> ( alien length c-type -- struct-array )
2009-08-26 14:13:19 -04:00
[ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
2008-12-03 10:41:48 -05:00
2008-12-03 10:54:02 -05:00
: malloc-struct-array ( length c-type -- struct-array )
[ heap-size calloc ] 2keep <direct-struct-array> ; inline
2008-12-03 10:54:02 -05:00
2008-12-03 10:41:48 -05:00
INSTANCE: struct-array sequence
M: struct-type <c-type-array> ( len c-type -- array )
dup c-type-array-constructor
[ execute( len -- array ) ]
[ <struct-array> ] ?if ; inline
M: struct-type <c-type-direct-array> ( alien len c-type -- array )
dup c-type-direct-array-constructor
[ execute( alien len -- array ) ]
[ <direct-struct-array> ] ?if ; inline