! 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 parser sequences sequences.private ;
+classes.struct kernel libc math parser sequences
+sequences.private words fry memoize compiler.units ;
IN: struct-arrays
: c-type-struct-class ( c-type -- class )
{ underlying c-ptr read-only }
{ length array-capacity read-only }
{ element-size array-capacity read-only }
-{ class read-only } ;
+{ class read-only }
+{ ctor read-only } ;
M: struct-array length length>> ; inline
M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
[ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
M: struct-array nth-unsafe
- [ (nth-ptr) ] [ class>> dup struct-class? ] bi [ memory>struct ] [ drop ] if ; inline
+ [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline
M: struct-array set-nth-unsafe
[ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
+: (struct-element-constructor) ( c-type -- word )
+ [
+ "struct-array-ctor" f <word>
+ [
+ swap dup struct-class?
+ [ '[ _ memory>struct ] [ ] like ] [ drop [ ] ] if
+ (( alien -- object )) define-inline
+ ] keep
+ ] with-compilation-unit ;
+
+! Foldable memo word. This is an optimization; by precompiling a
+! constructor for array elements, we avoid memory>struct's slow path.
+MEMO: struct-element-constructor ( c-type -- word )
+ (struct-element-constructor) ; foldable
+
+: <direct-struct-array> ( alien length c-type -- struct-array )
+ [ heap-size ] [ c-type-struct-class ] [ struct-element-constructor ]
+ tri struct-array boa ; inline
+
M: struct-array new-sequence
- [ element-size>> [ * (byte-array) ] 2keep ]
- [ class>> ] bi struct-array boa ; inline
+ [ element-size>> * (byte-array) ] [ length>> ] [ class>> ] tri
+ <direct-struct-array> ; inline
M: struct-array resize ( n seq -- newseq )
- [ [ element-size>> * ] [ underlying>> ] bi resize ]
- [ [ element-size>> ] [ class>> ] bi ] 2bi
- struct-array boa ;
+ [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi
+ <direct-struct-array> ; inline
: <struct-array> ( length c-type -- struct-array )
- [ heap-size [ * <byte-array> ] 2keep ]
- [ c-type-struct-class ] bi struct-array boa ; inline
+ [ heap-size * <byte-array> ] 2keep <direct-struct-array> ; 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 ] [ c-type-struct-class ] bi struct-array boa ; inline
-
-: <direct-struct-array> ( alien length c-type -- struct-array )
- [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
+ ] keep <direct-struct-array> ; inline
: struct-array-on ( struct length -- struct-array )
[ [ >c-ptr ] [ class ] bi ] dip swap <direct-struct-array> ; inline