diff --git a/basis/math/bits/authors.txt b/basis/math/bits/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/math/bits/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/math/bits/bits-docs.factor b/basis/math/bits/bits-docs.factor new file mode 100644 index 0000000000..6ae83f7af0 --- /dev/null +++ b/basis/math/bits/bits-docs.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup math ; +IN: math.bits + +ABOUT: "math.bits" + +ARTICLE: "math.bits" "Number bits virtual sequence" +{ $subsection bits } +{ $subsection } +{ $subsection make-bits } ; + +HELP: bits +{ $class-description "Virtual sequence class of bits of a number. The first bit is the least significant bit. This can be constructed with " { $link } " or " { $link make-bits } "." } ; + +HELP: +{ $values { "number" integer } { "length" integer } { "bits" bits } } +{ $description "Creates a virtual sequence of bits of a number in little endian order, with the given length." } ; + +HELP: make-bits +{ $values { "number" integer } { "bits" bits } } +{ $description "Creates a " { $link bits } " object out of the given number, using its log base 2 as the length. This implies that the last element, corresponding to the most significant bit, will be 1." } +{ $examples + { $example "USING: math.bits prettyprint arrays ;" "BIN: 1101 make-bits >array ." "{ t f t t }" } + { $example "USING: math.bits prettyprint arrays ;" "-3 make-bits >array ." "{ t f }" } +} ; diff --git a/basis/math/bits/bits-tests.factor b/basis/math/bits/bits-tests.factor new file mode 100644 index 0000000000..0503d27f33 --- /dev/null +++ b/basis/math/bits/bits-tests.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test math.bits sequences arrays ; +IN: math.bits.tests + +[ t ] [ BIN: 111111 3 second ] unit-test +[ { t t t } ] [ BIN: 111111 3 >array ] unit-test +[ f ] [ BIN: 111101 3 second ] unit-test +[ { f f t } ] [ BIN: 111100 3 >array ] unit-test +[ 3 ] [ BIN: 111111 3 length ] unit-test +[ 6 ] [ BIN: 111111 make-bits length ] unit-test +[ 0 ] [ 0 make-bits length ] unit-test +[ 2 ] [ 3 make-bits length ] unit-test +[ 2 ] [ -3 make-bits length ] unit-test +[ 1 ] [ 1 make-bits length ] unit-test +[ 1 ] [ -1 make-bits length ] unit-test diff --git a/basis/math/bits/bits.factor b/basis/math/bits/bits.factor new file mode 100644 index 0000000000..8920955df3 --- /dev/null +++ b/basis/math/bits/bits.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences kernel math accessors sequences.private ; +IN: math.bits + +TUPLE: bits { number read-only } { length read-only } ; +C: bits + +: make-bits ( number -- bits ) + dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1+ ] if ; inline + +M: bits length length>> ; + +M: bits nth-unsafe number>> swap bit? ; + +INSTANCE: bits immutable-sequence diff --git a/basis/math/bits/summary.txt b/basis/math/bits/summary.txt new file mode 100644 index 0000000000..265a7b8277 --- /dev/null +++ b/basis/math/bits/summary.txt @@ -0,0 +1 @@ +Virtual sequence for bits of an integer diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index 339703c0a6..4f639c02a7 100755 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math math.functions sequences +USING: arrays kernel math sequences accessors math.bits sequences.private words namespaces macros hints combinators fry io.binary combinators.smart ; IN: math.bitwise @@ -65,7 +65,7 @@ DEFER: byte-bit-count \ byte-bit-count 256 [ - 0 swap [ [ 1+ ] when ] each-bit + 8 0 [ [ 1+ ] when ] reduce ] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] (( byte -- table )) define-declared diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index b463a48e49..33a5d96fc4 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -278,14 +278,6 @@ HELP: mod-inv { $example "USING: math prettyprint ;" "173 815 * 1119 mod ." "1" } } ; -HELP: each-bit -{ $values { "n" integer } { "quot" { $quotation "( ? -- )" } } } -{ $description "Applies the quotation to each bit of the integer, starting from the least significant bit, and stopping at the last bit from which point on all bits are either clear (if the integer is positive) or all bits are set (if the integer is negataive)." } -{ $examples - { $example "USING: math.functions make prettyprint ;" "[ BIN: 1101 [ , ] each-bit ] { } make ." "{ t f t t }" } - { $example "USING: math.functions make prettyprint ;" "[ -3 [ , ] each-bit ] { } make ." "{ t f }" } -} ; - HELP: ~ { $values { "x" real } { "y" real } { "epsilon" real } { "?" "a boolean" } } { $description "Tests if " { $snippet "x" } " and " { $snippet "y" } " are approximately equal to each other. There are three possible comparison tests, chosen based on the sign of " { $snippet "epsilon" } ":" diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 85b4d711ac..7e2ac0884c 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: math kernel math.constants math.private +USING: math kernel math.constants math.private math.bits math.libm combinators math.order sequences ; IN: math.functions @@ -26,16 +26,6 @@ GENERIC: sqrt ( x -- y ) foldable M: real sqrt >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ; -: each-bit ( n quot: ( ? -- ) -- ) - over [ 0 = ] [ -1 = ] bi or [ - 2drop - ] [ - 2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread - ] if ; inline recursive - -: map-bits ( n quot: ( ? -- obj ) -- seq ) - accumulator [ each-bit ] dip ; inline - : factor-2s ( n -- r s ) #! factor an integer into 2^r * s dup 0 = [ 1 ] [ @@ -47,7 +37,7 @@ M: real sqrt GENERIC# ^n 1 ( z w -- z^w ) : (^n) ( z w -- z^w ) - 1 swap [ [ dupd * ] when [ sq ] dip ] each-bit nip ; inline + make-bits 1 [ [ dupd * ] when [ sq ] dip ] reduce nip ; inline M: integer ^n [ factor-2s ] dip [ (^n) ] keep rot * shift ; @@ -94,9 +84,9 @@ PRIVATE> dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline : (^mod) ( n x y -- z ) - 1 swap [ + make-bits 1 [ [ dupd * pick mod ] when [ sq over mod ] dip - ] each-bit 2nip ; inline + ] reduce 2nip ; inline : (gcd) ( b a x y -- a d ) over zero? [ diff --git a/extra/crypto/passwd-md5/passwd-md5.factor b/extra/crypto/passwd-md5/passwd-md5.factor index e292981876..286a313fda 100644 --- a/extra/crypto/passwd-md5/passwd-md5.factor +++ b/extra/crypto/passwd-md5/passwd-md5.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel base64 checksums.md5 sequences checksums -locals prettyprint math math.bitwise grouping io combinators +locals prettyprint math math.bits grouping io combinators fry make combinators.short-circuit math.functions splitting ; IN: crypto.passwd-md5 @@ -22,8 +22,8 @@ PRIVATE> password length [ 16 / ceiling swap concat ] keep head-slice append - password [ length ] [ first ] bi - '[ [ CHAR: \0 _ ? , ] each-bit ] "" make append + password [ length make-bits ] [ first ] bi + '[ CHAR: \0 _ ? ] "" map-as append md5 checksum-bytes ] | 1000 [ "" swap