Slices over specialized arrays can now be passed to C functions, written to binary...

[factor.git] / basis / alien / data / data.factor

diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor
index 1f2c5160e113c7b5a647b93e70daadbb9e0c2603..2d572e9f135b5a86363ceae97b31f646aac98063 100644 (file)
--- a/basis/alien/data/data.factor
+++ b/basis/alien/data/data.factor
@@ -1,35 +1,36 @@
-! (c)2009 Slava Pestov, Joe Groff bsd license
+! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
 USING: accessors alien alien.c-types alien.strings arrays
 byte-arrays cpu.architecture fry io io.encodings.binary
-io.files io.streams.memory kernel libc math sequences ;
+io.files io.streams.memory kernel libc math sequences words
+byte-vectors ;
 IN: alien.data
 
 GENERIC: require-c-array ( c-type -- )
 
 M: array require-c-array first require-c-array ;
 
-GENERIC: c-array-constructor ( c-type -- word )
+GENERIC: c-array-constructor ( c-type -- word ) foldable
 
-GENERIC: c-(array)-constructor ( c-type -- word )
+GENERIC: c-(array)-constructor ( c-type -- word ) foldable
 
-GENERIC: c-direct-array-constructor ( c-type -- word )
+GENERIC: c-direct-array-constructor ( c-type -- word ) foldable
 
 GENERIC: <c-array> ( len c-type -- array )
 
-M: c-type-name <c-array>
+M: word <c-array>
     c-array-constructor execute( len -- array ) ; inline
 
 GENERIC: (c-array) ( len c-type -- array )
 
-M: c-type-name (c-array)
+M: word (c-array)
     c-(array)-constructor execute( len -- array ) ; inline
 
 GENERIC: <c-direct-array> ( alien len c-type -- array )
 
-M: c-type-name <c-direct-array>
+M: word <c-direct-array>
     c-direct-array-constructor execute( alien len -- array ) ; inline
 
-: malloc-array ( n type -- alien )
+: malloc-array ( n type -- array )
     [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
 
 : (malloc-array) ( n type -- alien )
@@ -48,7 +49,7 @@ M: c-type-name <c-direct-array>
     heap-size malloc ; inline
 
 : malloc-byte-array ( byte-array -- alien )
-    dup byte-length [ nip malloc dup ] 2keep memcpy ;
+    binary-object [ nip malloc dup ] 2keep memcpy ;
 
 : memory>byte-array ( alien len -- byte-array )
     [ nip (byte-array) dup ] 2keep memcpy ;
@@ -56,21 +57,18 @@ M: c-type-name <c-direct-array>
 : malloc-string ( string encoding -- alien )
     string>alien malloc-byte-array ;
 
-: malloc-file-contents ( path -- alien len )
-    binary file-contents [ malloc-byte-array ] [ length ] bi ;
-
 M: memory-stream stream-read
     [
         [ index>> ] [ alien>> ] bi <displaced-alien>
         swap memory>byte-array
     ] [ [ + ] change-index drop ] 2bi ;
 
-: byte-array>memory ( byte-array base -- )
-    swap dup byte-length memcpy ; inline
-
-: >c-bool ( ? -- int ) 1 0 ? ; inline
-
-: c-bool> ( int -- ? ) 0 = not ; inline
+M: byte-vector stream-write
+    [ dup byte-length tail-slice ]
+    [ [ [ byte-length ] bi@ + ] keep lengthen ]
+    [ drop byte-length ]
+    2tri
+    [ >c-ptr swap >c-ptr ] dip memcpy ;
 
 M: value-type c-type-rep drop int-rep ;
 
@@ -80,4 +78,3 @@ M: value-type c-type-getter
 M: value-type c-type-setter ( type -- quot )
     [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
     '[ @ swap @ _ memcpy ] ;
-