Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2009-08-27 21:51:15 -05:00
commit b8978446d9
6 changed files with 11 additions and 23 deletions

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.strings alien.c-types alien.accessors alien.structs
arrays words sequences math kernel namespaces fry libc cpu.architecture
io.encodings.utf8 ;
io.encodings.utf8 accessors ;
IN: alien.arrays
UNION: value-type array struct-type ;
@ -13,7 +13,10 @@ M: array c-type-class drop object ;
M: array c-type-boxed-class drop object ;
M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
: array-length ( seq -- n )
[ dup word? [ def>> call( -- object ) ] when ] [ * ] map-reduce ;
M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ;
M: array c-type-align first c-type-align ;
@ -31,7 +34,7 @@ M: array stack-size drop "void*" stack-size ;
M: array c-type-boxer-quot
unclip
[ product ]
[ array-length ]
[ [ require-c-type-arrays ] keep ] bi*
[ <c-type-direct-array> ] 2curry ;

View File

@ -4,7 +4,7 @@ IN: alien.c-types.tests
CONSTANT: xyz 123
[ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
[ 492 ] [ { "int" xyz } heap-size ] unit-test
[ -1 ] [ -1 <char> *char ] unit-test
[ -1 ] [ -1 <short> *short ] unit-test

View File

@ -326,17 +326,6 @@ M: long-long-type box-return ( type -- )
[ define-out ]
tri ;
: expand-constants ( c-type -- c-type' )
dup array? [
unclip [
[
dup word? [
def>> call( -- object )
] when
] map
] dip prefix
] when ;
: malloc-file-contents ( path -- alien len )
binary file-contents [ malloc-byte-array ] [ length ] bi ;

View File

@ -16,7 +16,7 @@ TUPLE: field-spec name offset type reader writer ;
field-spec new
0 >>offset
swap >>name
swap expand-constants >>type
swap >>type
3dup name>> swap reader-word >>reader
3dup name>> swap writer-word >>writer
2nip ;

View File

@ -58,7 +58,6 @@ M: struct-type stack-size
[ define-field ] each ; deprecated
: define-union ( name members -- )
[ expand-constants ] map
[ [ heap-size ] [ max ] map-reduce ] keep
compute-struct-align f struct-type (define-struct) ; deprecated

View File

@ -14,9 +14,6 @@ TUPLE: alien-indirect-params < alien-node-params ;
TUPLE: alien-callback-params < alien-node-params quot xt ;
: pop-parameters ( -- seq )
pop-literal nip [ expand-constants ] map ;
: param-prep-quot ( node -- quot )
parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ;
@ -31,7 +28,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
: infer-alien-invoke ( -- )
alien-invoke-params new
! Compile-time parameters
pop-parameters >>parameters
pop-literal nip >>parameters
pop-literal nip >>function
pop-literal nip >>library
pop-literal nip >>return
@ -50,7 +47,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
alien-indirect-params new
! Compile-time parameters
pop-literal nip >>abi
pop-parameters >>parameters
pop-literal nip >>parameters
pop-literal nip >>return
! Quotation which coerces parameters to required types
dup param-prep-quot [ dip ] curry infer-quot-here
@ -71,7 +68,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
alien-callback-params new
pop-literal nip >>quot
pop-literal nip >>abi
pop-parameters >>parameters
pop-literal nip >>parameters
pop-literal nip >>return
gensym >>xt
dup callback-bottom