From 37cde9e234f7e39c7db339a6faa2a4065fe652ed Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 12 Jan 2008 23:32:42 -1000 Subject: [PATCH 1/8] fix stack effect --- extra/crypto/sha1/sha1.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 0613d01fcca9bd458820a39a993369e23c6bc9c0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Jan 2008 07:51:46 -1000 Subject: [PATCH 2/8] other algorithms use factor-2s, put it back to normal --- extra/math/miller-rabin/miller-rabin.factor | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor index 66d5793f93..4f139e38e6 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 = [ From 229576feece1e36d301131eb9e4e64458bc1bac5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Jan 2008 07:58:29 -1000 Subject: [PATCH 3/8] fix vim and gvim --- extra/editors/gvim/backend/backend.factor | 4 ++++ extra/editors/gvim/gvim.factor | 7 ++----- extra/editors/gvim/unix/unix.factor | 2 +- extra/editors/vim/vim-docs.factor | 3 ++- 4 files changed, 9 insertions(+), 7 deletions(-) create mode 100644 extra/editors/gvim/backend/backend.factor 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/editors/vim/vim-docs.factor b/extra/editors/vim/vim-docs.factor index 9f141f524f..2e2583cc7f 100644 --- a/extra/editors/vim/vim-docs.factor +++ b/extra/editors/vim/vim-docs.factor @@ -1,5 +1,6 @@ -USING: definitions editors.vim help help.markup help.syntax io io.files +USING: definitions help help.markup help.syntax io io.files editors words ; +IN: editors.vim ARTICLE: { "vim" "vim" } "Vim support" "This module makes the " { $link edit } " word work with Vim by setting the " { $link edit-hook } " global variable to call " { $link vim-location } ". The " { $link vim-path } " variable contains the name of the vim executable. The default " { $link vim-path } " is " { $snippet "\"gvim\"" } "." From a592f3a37b3df86851dab32dca6f7c7db19c22d8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Jan 2008 08:02:41 -1000 Subject: [PATCH 4/8] make singleton? foldable --- extra/sequences/lib/lib.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 ; From 376644794c03bb563c1769b6874d17aa1ddb3c61 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Jan 2008 08:29:04 -1000 Subject: [PATCH 5/8] more lint cleanups --- core/assocs/assocs.factor | 4 ++-- core/threads/threads.factor | 2 +- core/vocabs/vocabs.factor | 2 +- extra/benchmark/nsieve-bits/nsieve-bits.factor | 2 +- extra/calendar/calendar.factor | 9 +++------ extra/crypto/common/common.factor | 2 +- extra/http/client/client.factor | 2 +- extra/math/miller-rabin/miller-rabin.factor | 2 +- 8 files changed, 11 insertions(+), 14 deletions(-) diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 5079420b54..4dc3702c18 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 ) @@ -53,7 +53,7 @@ M: assoc assoc-find over >r assoc-pusher >r assoc-each r> r> assoc-like ; inline : assoc-all? ( assoc quot -- ? ) - [ not ] compose assoc-find 2nip not ; inline + [ not ] compose assoc-contains? not ; inline : assoc-contains? ( assoc quot -- ? ) assoc-find 2nip ; 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/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 4f139e38e6..5e8b9d8285 100644 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -77,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 From 669104c2e693d4d09ea55be845b2b9cacf7951e0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Jan 2008 10:02:02 -1000 Subject: [PATCH 6/8] fix ordering --- core/assocs/assocs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 4dc3702c18..799a6eb367 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -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-contains? 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 From a6d0c33a94ac1ada80e26ecc12d31231d24a3633 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 13 Jan 2008 10:09:59 -1000 Subject: [PATCH 7/8] fix word name --- extra/math/miller-rabin/miller-rabin.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor index 5e8b9d8285..de5a262268 100644 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -77,7 +77,7 @@ TUPLE: miller-rabin-bounds ; >odd (find-relative-prime) ; : find-relative-prime ( n -- p ) - dup random (find-relative-prime*) ; + dup random find-relative-prime* ; : unique-primes ( numbits n -- seq ) #! generate two primes From 969901a73da406b19ecdca35887f571e143bed42 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 13 Jan 2008 22:44:20 +1300 Subject: [PATCH 8/8] Fix openal loading on non-mac platforms --- extra/openal/other/other.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 ;