steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

alien.data: make binary-zero? public and move it from classes.struct.private

db4
Joe Groff 2010-06-10 17:05:43 -07:00
parent e84b2e8c60
commit c8ea7ed0c7
4 changed files with 48 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
basis/alien/data/data-tests.factor Normal file
View File

@ -0,0 +1,35 @@
USING: alien alien.c-types alien.data alien.syntax
classes.struct kernel sequences specialized-arrays
tools.test ;
IN: alien.data.tests
STRUCT: foo { a int } { b void* } { c bool } ;
SPECIALIZED-ARRAY: foo
[ t ] [ 0 binary-zero? ] unit-test
[ f ] [ 1 binary-zero? ] unit-test
[ f ] [ -1 binary-zero? ] unit-test
[ t ] [ 0.0 binary-zero? ] unit-test
[ f ] [ 1.0 binary-zero? ] unit-test
[ f ] [ -0.0 binary-zero? ] unit-test
[ t ] [ C{ 0.0 0.0 } binary-zero? ] unit-test
[ f ] [ C{ 1.0 0.0 } binary-zero? ] unit-test
[ f ] [ C{ -0.0 0.0 } binary-zero? ] unit-test
[ f ] [ C{ 0.0 1.0 } binary-zero? ] unit-test
[ f ] [ C{ 0.0 -0.0 } binary-zero? ] unit-test
[ t ] [ f binary-zero? ] unit-test
[ t ] [ 0 <alien> binary-zero? ] unit-test
[ f ] [ 1 <alien> binary-zero? ] unit-test
[ f ] [ B{ } binary-zero? ] unit-test
[ t ] [ S{ foo f 0 f f } binary-zero? ] unit-test
[ f ] [ S{ foo f 1 f f } binary-zero? ] unit-test
[ f ] [ S{ foo f 0 ALIEN: 8 f } binary-zero? ] unit-test
[ f ] [ S{ foo f 0 f t } binary-zero? ] unit-test
[ t t f ] [
foo-array{
S{ foo f 0 f f }
S{ foo f 0 f f }
S{ foo f 1 f f }
} [ first binary-zero? ] [ second binary-zero? ] [ third binary-zero? ] tri
] unit-test

14
basis/alien/data/data.factor
View File

@ -1,8 +1,9 @@
! (c)2009, 2010 Slava Pestov, Joe Groff bsd license ! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
USING: accessors alien alien.c-types alien.arrays alien.strings USING: accessors alien alien.c-types alien.arrays alien.strings
arrays byte-arrays cpu.architecture fry io io.encodings.binary arrays byte-arrays cpu.architecture fry io io.encodings.binary
io.files io.streams.memory kernel libc math sequences words io.files io.streams.memory kernel libc math math.functions
macros combinators generalizations ; sequences words macros combinators generalizations ;
QUALIFIED: math
IN: alien.data IN: alien.data
GENERIC: require-c-array ( c-type -- ) GENERIC: require-c-array ( c-type -- )
@ -106,3 +107,12 @@ PRIVATE>
: with-out-parameters ( c-types quot finish -- values ) : with-out-parameters ( c-types quot finish -- values )
[ [ drop (local-allots) ] [ swap out-parameters ] 2bi ] dip call [ [ drop (local-allots) ] [ swap out-parameters ] 2bi ] dip call
(cleanup-allot) ; inline (cleanup-allot) ; inline
GENERIC: binary-zero? ( value -- ? )
M: object binary-zero? drop f ; inline
M: f binary-zero? drop t ; inline
M: integer binary-zero? zero? ; inline
M: math:float binary-zero? double>bits zero? ; inline
M: complex binary-zero? >rect [ binary-zero? ] both? ; inline

29
basis/classes/struct/struct-tests.factor
View File

@ -9,7 +9,6 @@ system tools.test parser lexer eval layouts generic.single classes
vocabs ; vocabs ;
FROM: math => float ; FROM: math => float ;
FROM: specialized-arrays.private => specialized-array-vocab ; FROM: specialized-arrays.private => specialized-array-vocab ;
FROM: classes.struct.private => binary-zero? ;
QUALIFIED-WITH: alien.c-types c QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: char
SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: int
@ -476,31 +475,3 @@ CONSULT: struct-test-delegate struct-test-delegator del>> ;
8 >>b 8 >>b
] unit-test ] unit-test
SPECIALIZED-ARRAY: struct-test-foo
[ t ] [ 0 binary-zero? ] unit-test
[ f ] [ 1 binary-zero? ] unit-test
[ f ] [ -1 binary-zero? ] unit-test
[ t ] [ 0.0 binary-zero? ] unit-test
[ f ] [ 1.0 binary-zero? ] unit-test
[ f ] [ -0.0 binary-zero? ] unit-test
[ t ] [ C{ 0.0 0.0 } binary-zero? ] unit-test
[ f ] [ C{ 1.0 0.0 } binary-zero? ] unit-test
[ f ] [ C{ -0.0 0.0 } binary-zero? ] unit-test
[ f ] [ C{ 0.0 1.0 } binary-zero? ] unit-test
[ f ] [ C{ 0.0 -0.0 } binary-zero? ] unit-test
[ t ] [ f binary-zero? ] unit-test
[ t ] [ 0 <alien> binary-zero? ] unit-test
[ f ] [ 1 <alien> binary-zero? ] unit-test
[ f ] [ B{ } binary-zero? ] unit-test
[ t ] [ S{ struct-test-foo f 0 0 f } binary-zero? ] unit-test
[ f ] [ S{ struct-test-foo f 1 0 f } binary-zero? ] unit-test
[ f ] [ S{ struct-test-foo f 0 1 f } binary-zero? ] unit-test
[ f ] [ S{ struct-test-foo f 0 0 t } binary-zero? ] unit-test
[ t t f ] [
struct-test-foo-array{
S{ struct-test-foo f 0 0 f }
S{ struct-test-foo f 0 0 f }
S{ struct-test-foo f 1 0 f }
} [ first binary-zero? ] [ second binary-zero? ] [ third binary-zero? ] tri
] unit-test

11
basis/classes/struct/struct.factor
View File

@ -11,7 +11,6 @@ namespaces assocs vocabs.parser math.functions
classes.struct.bit-accessors bit-arrays classes.struct.bit-accessors bit-arrays
stack-checker.dependencies system layouts ; stack-checker.dependencies system layouts ;
FROM: delegate.private => group-words slot-group-words ; FROM: delegate.private => group-words slot-group-words ;
FROM: math => float ;
QUALIFIED: math QUALIFIED: math
IN: classes.struct IN: classes.struct
@ -232,19 +231,11 @@ M: struct-bit-slot-spec compute-slot-offset
PRIVATE> PRIVATE>
M: struct byte-length class "struct-size" word-prop ; foldable M: struct byte-length class "struct-size" word-prop ; foldable
M: struct binary-zero? binary-object <direct-uchar-array> [ 0 = ] all? ; inline
! class definition ! class definition
<PRIVATE <PRIVATE
GENERIC: binary-zero? ( value -- ? )
M: object binary-zero? drop f ; inline
M: f binary-zero? drop t ; inline
M: integer binary-zero? zero? ; inline
M: float binary-zero? double>bits zero? ; inline
M: complex binary-zero? >rect [ binary-zero? ] both? ; inline
M: struct binary-zero? binary-object <direct-uchar-array> [ 0 = ] all? ; inline
: struct-needs-prototype? ( class -- ? ) : struct-needs-prototype? ( class -- ? )
struct-slots [ initial>> binary-zero? ] all? not ; struct-slots [ initial>> binary-zero? ] all? not ;