diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 5079420b54..799a6eb367 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -43,7 +43,7 @@ M: assoc assoc-find inline : assoc-push-if ( key value quot accum -- ) - >r 2over 2slip r> roll + >r 2keep r> roll [ >r 2array r> push ] [ 3drop ] if ; inline : assoc-pusher ( quot -- quot' accum ) @@ -52,12 +52,12 @@ M: assoc assoc-find : assoc-subset ( assoc quot -- subassoc ) over >r assoc-pusher >r assoc-each r> r> assoc-like ; inline -: assoc-all? ( assoc quot -- ? ) - [ not ] compose assoc-find 2nip not ; inline - : assoc-contains? ( assoc quot -- ? ) assoc-find 2nip ; inline +: assoc-all? ( assoc quot -- ? ) + [ not ] compose assoc-contains? not ; inline + : at ( key assoc -- value/f ) at* drop ; inline diff --git a/core/threads/threads.factor b/core/threads/threads.factor index 7a67d1b531..ee136654df 100644 --- a/core/threads/threads.factor +++ b/core/threads/threads.factor @@ -32,7 +32,7 @@ PRIVATE> : stop ( -- ) walker-hook [ - f swap continue-with + continue ] [ run-queue pop-back dup array? [ first2 continue-with ] [ continue ] if diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 910410c84c..8db65e2eac 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -102,7 +102,7 @@ M: vocab-link vocab-name vocab-link-name ; UNION: vocab-spec vocab vocab-link ; : forget-vocab ( vocab -- ) - dup vocab-words values forget-all + dup words forget-all vocab-name dictionary get delete-at ; M: vocab-spec forget* forget-vocab ; diff --git a/extra/benchmark/nsieve-bits/nsieve-bits.factor b/extra/benchmark/nsieve-bits/nsieve-bits.factor index 46ebc6595e..fe70246cb5 100644 --- a/extra/benchmark/nsieve-bits/nsieve-bits.factor +++ b/extra/benchmark/nsieve-bits/nsieve-bits.factor @@ -28,7 +28,7 @@ bit-arrays namespaces io ; : nsieve-bits-main ( n -- ) dup 2^ 10000 * nsieve-bits. - dup 1 - 2^ 10000 * nsieve-bits. + dup 1- 2^ 10000 * nsieve-bits. 2 - 2^ 10000 * nsieve-bits. ; : nsieve-bits-main* 11 nsieve-bits-main ; diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 4e473279fa..c9b62ce7aa 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -96,12 +96,12 @@ SYMBOL: m : zero-dt ( --
) 0 0 0 0 0 0
; : years ( n -- dt ) zero-dt [ set-dt-year ] keep ; : months ( n -- dt ) zero-dt [ set-dt-month ] keep ; -: weeks ( n -- dt ) 7 * zero-dt [ set-dt-day ] keep ; : days ( n -- dt ) zero-dt [ set-dt-day ] keep ; +: weeks ( n -- dt ) 7 * days ; : hours ( n -- dt ) zero-dt [ set-dt-hour ] keep ; : minutes ( n -- dt ) zero-dt [ set-dt-minute ] keep ; : seconds ( n -- dt ) zero-dt [ set-dt-second ] keep ; -: milliseconds ( n -- dt ) 1000 /f zero-dt [ set-dt-second ] keep ; +: milliseconds ( n -- dt ) 1000 /f seconds ; : julian-day-number>timestamp ( n -- timestamp ) julian-day-number>date 0 0 0 0 ; @@ -259,10 +259,7 @@ M: timestamp <=> ( ts1 ts2 -- n ) 1+ + 7 mod ; : day-of-week ( timestamp -- n ) - [ timestamp-year ] keep - [ timestamp-month ] keep - timestamp-day - zeller-congruence ; + >date< zeller-congruence ; : day-of-year ( timestamp -- n ) [ diff --git a/extra/crypto/common/common.factor b/extra/crypto/common/common.factor index e98f0cd959..3ac551d114 100644 --- a/extra/crypto/common/common.factor +++ b/extra/crypto/common/common.factor @@ -40,7 +40,7 @@ SYMBOL: big-endian? ] "" make 64 group ; : shift-mod ( n s w -- n ) - >r shift r> 1 swap shift 1 - bitand ; inline + >r shift r> 2^ 1- bitand ; inline : update-old-new ( old new -- ) [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor index e7ecc4e151..6906ce2b9a 100644 --- a/extra/crypto/sha1/sha1.factor +++ b/extra/crypto/sha1/sha1.factor @@ -126,7 +126,7 @@ SYMBOL: K : string>sha1-bignum ( string -- n ) string>sha1 be> ; : file>sha1 ( file -- sha1 ) stream>sha1 ; -: string>sha1-interleave ( string -- ) +: string>sha1-interleave ( string -- seq ) [ zero? ] left-trim dup length odd? [ 1 tail ] when seq>2seq [ string>sha1 ] 2apply diff --git a/extra/editors/gvim/backend/backend.factor b/extra/editors/gvim/backend/backend.factor new file mode 100644 index 0000000000..e2e2f0626e --- /dev/null +++ b/extra/editors/gvim/backend/backend.factor @@ -0,0 +1,4 @@ +USING: io.backend ; +IN: editors.gvim.backend + +HOOK: gvim-path io-backend ( -- path ) diff --git a/extra/editors/gvim/gvim.factor b/extra/editors/gvim/gvim.factor index 8b3573d03e..775d008963 100755 --- a/extra/editors/gvim/gvim.factor +++ b/extra/editors/gvim/gvim.factor @@ -1,13 +1,10 @@ USING: io.backend io.files kernel math math.parser -namespaces editors.vim sequences system combinators -vocabs.loader ; +namespaces sequences system combinators +editors.vim editors.gvim.backend vocabs.loader ; IN: editors.gvim TUPLE: gvim ; -HOOK: gvim-path io-backend ( -- path ) - - M: gvim vim-command ( file line -- string ) [ "\"" % gvim-path % "\" \"" % swap % "\" +" % # ] "" make ; diff --git a/extra/editors/gvim/unix/unix.factor b/extra/editors/gvim/unix/unix.factor index fd295cc9e9..a7de09c013 100644 --- a/extra/editors/gvim/unix/unix.factor +++ b/extra/editors/gvim/unix/unix.factor @@ -1,4 +1,4 @@ -USING: editors.gvim io.unix.backend kernel namespaces ; +USING: io.unix.backend kernel namespaces editors.gvim.backend ; IN: editors.gvim.unix M: unix-io gvim-path diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor index 08c5185cd2..f117a4fda1 100644 --- a/extra/http/client/client.factor +++ b/extra/http/client/client.factor @@ -29,7 +29,7 @@ IN: http.client : crlf "\r\n" write ; : http-request ( host resource method -- ) - write " " write write " HTTP/1.0" write crlf + write bl write " HTTP/1.0" write crlf "Host: " write write crlf ; : get-request ( host resource -- ) diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor index 66d5793f93..de5a262268 100644 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -20,12 +20,19 @@ SYMBOL: trials : random-bits ( m -- n ) 2^ random ; foldable -: factor-2s ( zero n -- r s ) - #! factor an even number into 2 ^ s * m - dup even? [ -1 shift >r 1+ r> factor-2s ] when ; +TUPLE: positive-even-expected n ; + +: (factor-2s) ( r s -- r s ) + dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ; + +: factor-2s ( n -- r s ) + #! factor an even number into s * 2 ^ r + dup even? over 0 > and [ + positive-even-expected construct-boa throw + ] unless 0 swap (factor-2s) ; :: (miller-rabin) | n prime?! | - 0 n 1- factor-2s s set r set + n 1- factor-2s s set r set trials get [ n 1- [1,b] random a set a get s get n ^mod 1 = [ @@ -70,7 +77,7 @@ TUPLE: miller-rabin-bounds ; >odd (find-relative-prime) ; : find-relative-prime ( n -- p ) - dup random >odd (find-relative-prime) ; + dup random find-relative-prime* ; : unique-primes ( numbits n -- seq ) #! generate two primes diff --git a/extra/openal/other/other.factor b/extra/openal/other/other.factor index 08b12426b3..e32b007973 100644 --- a/extra/openal/other/other.factor +++ b/extra/openal/other/other.factor @@ -2,13 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. ! IN: openal.other -USING: openal alien.c-types kernel alien alien.syntax shuffle combinators.lib ; +USING: openal.backend alien.c-types kernel alien alien.syntax shuffle combinators.lib ; LIBRARY: alut FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency, ALboolean* looping ) ; -M: other-openal-impl load-wav-file ( filename -- format data size frequency ) +M: other-openal-backend load-wav-file ( filename -- format data size frequency ) 0 f 0 0 [ 0 alutLoadWAVFile ] 4keep >r >r >r *int r> *void* r> *int r> *int ; diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index e46ce3b107..37b00042d2 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -59,7 +59,7 @@ IN: sequences.lib ] { } make ; : singleton? ( seq -- ? ) - length 1 = ; + length 1 = ; foldable : delete-random ( seq -- value ) [ length random ] keep [ nth ] 2keep delete-nth ;