From 0add13c50ca8472dda5e6c2ec3c07c0971d2acd6 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 10 Jun 2010 17:05:43 -0700 Subject: [PATCH] alien.data: make binary-zero? public and move it from classes.struct.private --- basis/alien/data/data-tests.factor | 35 ++++++++++++++++++++++++ basis/alien/data/data.factor | 14 ++++++++-- basis/classes/struct/struct-tests.factor | 29 -------------------- basis/classes/struct/struct.factor | 11 +------- 4 files changed, 48 insertions(+), 41 deletions(-) create mode 100644 basis/alien/data/data-tests.factor diff --git a/basis/alien/data/data-tests.factor b/basis/alien/data/data-tests.factor new file mode 100644 index 0000000000..d17675e98c --- /dev/null +++ b/basis/alien/data/data-tests.factor @@ -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 binary-zero? ] unit-test +[ f ] [ 1 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 diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor index 81b53a1b39..2f5e4b72c6 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -1,8 +1,9 @@ ! (c)2009, 2010 Slava Pestov, Joe Groff bsd license USING: accessors alien alien.c-types alien.arrays alien.strings arrays byte-arrays cpu.architecture fry io io.encodings.binary -io.files io.streams.memory kernel libc math sequences words -macros combinators generalizations ; +io.files io.streams.memory kernel libc math math.functions +sequences words macros combinators generalizations ; +QUALIFIED: math IN: alien.data GENERIC: require-c-array ( c-type -- ) @@ -106,3 +107,12 @@ PRIVATE> : with-out-parameters ( c-types quot finish -- values ) [ [ drop (local-allots) ] [ swap out-parameters ] 2bi ] dip call (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 + diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index ab354bb569..8bdfb8dd57 100644 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -9,7 +9,6 @@ system tools.test parser lexer eval layouts generic.single classes vocabs ; FROM: math => float ; FROM: specialized-arrays.private => specialized-array-vocab ; -FROM: classes.struct.private => binary-zero? ; QUALIFIED-WITH: alien.c-types c SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: int @@ -476,31 +475,3 @@ CONSULT: struct-test-delegate struct-test-delegator del>> ; 8 >>b ] 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 binary-zero? ] unit-test -[ f ] [ 1 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 diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 43578ba2a5..c15e21f651 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -11,7 +11,6 @@ namespaces assocs vocabs.parser math.functions classes.struct.bit-accessors bit-arrays stack-checker.dependencies system layouts ; FROM: delegate.private => group-words slot-group-words ; -FROM: math => float ; QUALIFIED: math IN: classes.struct @@ -232,19 +231,11 @@ M: struct-bit-slot-spec compute-slot-offset PRIVATE> M: struct byte-length class "struct-size" word-prop ; foldable +M: struct binary-zero? binary-object [ 0 = ] all? ; inline ! class definition bits zero? ; inline -M: complex binary-zero? >rect [ binary-zero? ] both? ; inline -M: struct binary-zero? binary-object [ 0 = ] all? ; inline - : struct-needs-prototype? ( class -- ? ) struct-slots [ initial>> binary-zero? ] all? not ;