diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index fbf59e6f11..e56f151383 100755 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -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* [ ] 2curry ; diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 0de26aad20..bfeff5f1de 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -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 ] unit-test [ -1 ] [ -1 *short ] unit-test diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 400af25373..4c3c8d1668 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -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 ; diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor index f958847abd..1fa2fe0b0c 100644 --- a/basis/alien/structs/fields/fields.factor +++ b/basis/alien/structs/fields/fields.factor @@ -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 ; diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index fed3ce801b..05558040e8 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -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 diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index 0b135319ff..da559abd78 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -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