From 3dc417ae6479305091e15380f99b4251cfa2462b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 11 Dec 2008 18:52:22 -0600 Subject: [PATCH 01/13] bool -> ? --- basis/db/sqlite/lib/lib.factor | 2 +- basis/smtp/smtp.factor | 2 +- basis/ui/windows/windows.factor | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index 1ec18260cd..bcd38b172d 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -166,7 +166,7 @@ ERROR: sqlite-sql-error < sql-error n string ; : sqlite-row ( handle -- seq ) dup sqlite-#columns [ sqlite-column ] with map ; -: sqlite-step-has-more-rows? ( prepared -- bool ) +: sqlite-step-has-more-rows? ( prepared -- ? ) { { SQLITE_ROW [ t ] } { SQLITE_DONE [ f ] } diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index f689ad0858..0f16863a79 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -102,7 +102,7 @@ M: message-contains-dot summary ( obj -- string ) LOG: smtp-response DEBUG -: multiline? ( response -- boolean ) +: multiline? ( response -- ? ) 3 swap ?nth CHAR: - = ; : (receive-response) ( -- ) diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 10539df8e7..626deb12a4 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -170,10 +170,10 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ; { 27 "ESC" } } ; -: exclude-key-wm-keydown? ( n -- bool ) +: exclude-key-wm-keydown? ( n -- ? ) exclude-keys-wm-keydown key? ; -: exclude-key-wm-char? ( n -- bool ) +: exclude-key-wm-char? ( n -- ? ) exclude-keys-wm-char key? ; : keystroke>gesture ( n -- mods sym ) From afe942130edef0def7e781587aa7fd7be85a403e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 11 Dec 2008 23:11:04 -0600 Subject: [PATCH 02/13] Add deep-member? and deep-subseq? to sequences.deep. --- basis/sequences/deep/authors.txt | 1 + basis/sequences/deep/deep-tests.factor | 15 +++++++++++++++ basis/sequences/deep/deep.factor | 14 ++++++++++++-- 3 files changed, 28 insertions(+), 2 deletions(-) diff --git a/basis/sequences/deep/authors.txt b/basis/sequences/deep/authors.txt index f990dd0ed2..a07c427c98 100644 --- a/basis/sequences/deep/authors.txt +++ b/basis/sequences/deep/authors.txt @@ -1 +1,2 @@ Daniel Ehrenberg +Doug Coleman diff --git a/basis/sequences/deep/deep-tests.factor b/basis/sequences/deep/deep-tests.factor index 522b5ecdf9..2d3260f427 100644 --- a/basis/sequences/deep/deep-tests.factor +++ b/basis/sequences/deep/deep-tests.factor @@ -24,3 +24,18 @@ IN: sequences.deep.tests [ "foo" ] [ "foo" [ string? ] deep-find ] unit-test [ { { 1 2 } 1 2 } ] [ [ { 1 2 } [ , ] deep-each ] { } make ] unit-test + +[ t ] +[ { { 1 2 3 } 4 } { { { 1 { { 1 2 3 } 4 } } } 2 } deep-member? ] unit-test + +[ t ] +[ { { 1 2 3 } 4 } { { { 1 2 3 } 4 } 2 } deep-member? ] unit-test + +[ f ] +[ { 1 2 3 4 } { 1 2 3 { 4 } } deep-subseq? ] unit-test + +[ t ] +[ { 1 2 3 4 } { 1 2 3 4 } deep-subseq? ] unit-test + +[ t ] +[ { 1 2 3 4 } { { 1 2 3 4 } } deep-subseq? ] unit-test diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor index db572681a1..244040d60a 100644 --- a/basis/sequences/deep/deep.factor +++ b/basis/sequences/deep/deep.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2007 Daniel Ehrenberg +! Copyright (C) 2007, 2008 Daniel Ehrenberg, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: sequences kernel strings math ; +USING: sequences kernel strings math fry ; IN: sequences.deep ! All traversal goes in postorder @@ -38,6 +38,16 @@ M: object branch? drop f ; : deep-all? ( obj quot -- ? ) [ not ] compose deep-contains? not ; inline +: deep-member? ( obj seq -- ? ) + swap '[ + _ swap dup branch? [ member? ] [ 2drop f ] if + ] deep-find >boolean ; + +: deep-subseq? ( subseq seq -- ? ) + swap '[ + _ swap dup branch? [ subseq? ] [ 2drop f ] if + ] deep-find >boolean ; + : deep-change-each ( obj quot: ( elt -- elt' ) -- ) over branch? [ [ [ call ] keep over [ deep-change-each ] dip ] curry change-each From ae1ebf58acfcd9640eb34418a6582ffd8607e180 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:37:37 -0600 Subject: [PATCH 03/13] remove >r r> from extra/roman --- extra/roman/roman.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor index 5ffdf67753..978587c685 100644 --- a/extra/roman/roman.factor +++ b/extra/roman/roman.factor @@ -26,7 +26,7 @@ ERROR: roman-range-error n ; : (>roman) ( n -- ) roman-values roman-digits [ - >r /mod swap r> concat % + [ /mod swap ] dip concat % ] 2each drop ; : (roman>) ( seq -- n ) @@ -56,7 +56,7 @@ PRIVATE> [ roman> ] bi@ ; : binary-roman-op ( str1 str2 quot -- str3 ) - >r 2roman> r> call >roman ; inline + [ 2roman> ] dip call >roman ; inline PRIVATE> @@ -73,6 +73,6 @@ PRIVATE> [ /i ] binary-roman-op ; : roman/mod ( str1 str2 -- str3 str4 ) - [ /mod ] binary-roman-op >r >roman r> ; + [ /mod ] binary-roman-op [ >roman ] dip ; : ROMAN: scan roman> parsed ; parsing From 0329083970abb866293aa8a11b039b934050e553 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:38:37 -0600 Subject: [PATCH 04/13] remove >r r> --- extra/html/parser/analyzer/analyzer.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index a18bb31874..abe830c3fa 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -130,7 +130,7 @@ TUPLE: link attributes clickable ; : find-forms ( vector -- vector' ) "form" over find-opening-tags-by-name - swap [ >r first2 r> find-between* ] curry map + swap [ [ first2 ] dip find-between* ] curry map [ [ name>> { "form" "input" } member? ] filter ] map ; : find-html-objects ( vector string -- vector' ) From 8887fbaa528c7d2f406689c4c6afc1310b8afe57 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:41:30 -0600 Subject: [PATCH 05/13] remove >r r> --- extra/units/units.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/units/units.factor b/extra/units/units.factor index 02005fcd1f..b8e3f45a16 100755 --- a/extra/units/units.factor +++ b/extra/units/units.factor @@ -81,7 +81,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; : d= ( d d -- ? ) comparison-op number= ; -: d~ ( d d delta -- ? ) >r comparison-op r> ~ ; +: d~ ( d d delta -- ? ) [ comparison-op ] dip ~ ; : d-min ( d d -- d ) [ d< ] most ; From 1ef79bc87fdf9c6753fe0c6998ae14e11116f7c0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:43:48 -0600 Subject: [PATCH 06/13] remove slides/lib.factor -- why was it still here? --- extra/slides/lib.factor | 52 ----------------------------------------- 1 file changed, 52 deletions(-) delete mode 100755 extra/slides/lib.factor diff --git a/extra/slides/lib.factor b/extra/slides/lib.factor deleted file mode 100755 index f9708b3ca7..0000000000 --- a/extra/slides/lib.factor +++ /dev/null @@ -1,52 +0,0 @@ -USING: arrays assocs kernel vectors sequences namespaces - random math.parser math fry ; - -IN: assocs.lib - -: set-assoc-stack ( value key seq -- ) - dupd [ key? ] with find-last nip set-at ; - -: at-default ( key assoc -- value/key ) - dupd at [ nip ] when* ; - -: replace-at ( assoc value key -- assoc ) - >r >r dup r> 1vector r> rot set-at ; - -: peek-at* ( assoc key -- obj ? ) - swap at* dup [ >r peek r> ] when ; - -: peek-at ( assoc key -- obj ) - peek-at* drop ; - -: >multi-assoc ( assoc -- new-assoc ) - [ 1vector ] assoc-map ; - -: multi-assoc-each ( assoc quot -- ) - [ with each ] curry assoc-each ; inline - -: insert ( value variable -- ) namespace push-at ; - -: generate-key ( assoc -- str ) - >r 32 random-bits >hex r> - 2dup key? [ nip generate-key ] [ drop ] if ; - -: set-at-unique ( value assoc -- key ) - dup generate-key [ swap set-at ] keep ; - -: histogram ( assoc quot -- assoc' ) - H{ } clone [ - swap [ change-at ] 2curry assoc-each - ] keep ; inline - -: inc-at ( key assoc -- ) - [ 0 or 1 + ] change-at ; - -: ?at ( obj assoc -- value/obj ? ) - dupd at* [ [ nip ] [ drop ] if ] keep ; - -: if-at ( obj assoc quot1 quot2 -- ) - [ ?at ] 2dip if ; inline - -: when-at ( obj assoc quot -- ) [ ] if-at ; inline - -: unless-at ( obj assoc quot -- ) [ ] swap if-at ; inline From 3b5a6b8dc97bb8468f61cda4991b36adb10cc829 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:44:23 -0600 Subject: [PATCH 07/13] remove >r r> --- extra/taxes/usa/federal/federal.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor index b71b831ca6..4b6d516369 100644 --- a/extra/taxes/usa/federal/federal.factor +++ b/extra/taxes/usa/federal/federal.factor @@ -56,4 +56,4 @@ M: federal withholding* ( salary w4 tax-table entity -- x ) ] if ; : net ( salary w4 collector -- x ) - >r dupd r> total-withholding - ; + [ dupd ] dip total-withholding - ; From 0c1d5ccbb155ef377c0d4fb8d014ded6585d137e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:45:46 -0600 Subject: [PATCH 08/13] remove >r r> --- extra/namespaces/lib/lib.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/namespaces/lib/lib.factor b/extra/namespaces/lib/lib.factor index ae0887e45a..dfa4df245c 100755 --- a/extra/namespaces/lib/lib.factor +++ b/extra/namespaces/lib/lib.factor @@ -6,7 +6,7 @@ IN: namespaces.lib ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: save-namestack ( quot -- ) namestack >r call r> set-namestack ; +: save-namestack ( quot -- ) namestack slip set-namestack ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 6671193879d4fbb1d4c53685187ff0c7d1913cbe Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:48:06 -0600 Subject: [PATCH 09/13] remove >r r> --- extra/bank/bank.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/bank/bank.factor b/extra/bank/bank.factor index a409c97815..0f8b5581df 100644 --- a/extra/bank/bank.factor +++ b/extra/bank/bank.factor @@ -20,7 +20,7 @@ C: transaction : balance>> ( account -- balance ) transactions>> total ; : open-account ( name interest-rate interest-payment-day opening-date opening-balance -- account ) - >r [ ] keep r> "Account Opened" >>transaction ; + [ [ ] keep ] dip "Account Opened" >>transaction ; : daily-rate ( yearly-rate day -- daily-rate ) days-in-year / ; @@ -56,7 +56,7 @@ C: transaction : each-day ( quot start end -- ) 2dup before? [ - >r dup >r over >r swap call r> r> 1 days time+ r> each-day + [ dup [ over [ swap call ] dip ] dip 1 days time+ ] dip each-day ] [ 3drop ] if ; From 25ef292d60528d679b574ae677854c4db0c476a4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:51:00 -0600 Subject: [PATCH 10/13] remove >r r> --- extra/crypto/hmac/hmac.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor index b480c18913..62103bf510 100755 --- a/extra/crypto/hmac/hmac.factor +++ b/extra/crypto/hmac/hmac.factor @@ -10,15 +10,15 @@ IN: crypto.hmac initialize-sha1 process-sha1-block stream>sha1 get-sha1 initialize-sha1 - >r process-sha1-block r> - process-sha1-block get-sha1 ; + [ process-sha1-block ] + [ process-sha1-block ] bi* get-sha1 ; : md5-hmac ( Ko Ki -- hmac ) initialize-md5 process-md5-block stream>md5 get-md5 initialize-md5 - >r process-md5-block r> - process-md5-block get-md5 ; + [ process-md5-block ] + [ process-md5-block ] bi* get-md5 ; : seq-bitxor ( seq seq -- seq ) [ bitxor ] 2map ; From fcb761d257e1729fc398c857e474609925206ea6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 00:52:15 -0600 Subject: [PATCH 11/13] remove >r r> --- extra/state-machine/state-machine.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/state-machine/state-machine.factor b/extra/state-machine/state-machine.factor index 37e12a6993..18c3720927 100755 --- a/extra/state-machine/state-machine.factor +++ b/extra/state-machine/state-machine.factor @@ -21,14 +21,14 @@ M: missing-state error. ! quot is ( state string -- output-string ) [ missing-state ] dup [ - [ >r dup [ data>> ] [ place>> ] bi r> ] % + [ [ dup [ data>> ] [ place>> ] bi ] dip ] % [ swapd bounds-check dispatch ] curry , [ each pick (>>place) swap (>>date) ] % ] [ ] make [ over make ] curry ; : define-machine ( word state-class -- ) execute make-machine - >r over r> define + [ over ] dip define "state-table" set-word-prop ; : MACHINE: From 35f01b15772b60c715c10c61d1408cc15d5a57f5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 14 Dec 2008 01:34:58 -0600 Subject: [PATCH 12/13] remove >r r> --- basis/windows/com/wrapper/wrapper.factor | 2 +- basis/windows/time/time.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index 710feeec4d..813d8315ac 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -123,7 +123,7 @@ unless : (make-callbacks) ( implementations -- sequence ) dup [ first ] map (make-iunknown-methods) - [ >r >r first2 r> r> swap (make-interface-callbacks) ] + [ [ first2 ] 2dip swap (make-interface-callbacks) ] curry map-index ; : (malloc-wrapped-object) ( wrapper -- wrapped-object ) diff --git a/basis/windows/time/time.factor b/basis/windows/time/time.factor index 5e23f8cc01..5ffc62680e 100644 --- a/basis/windows/time/time.factor +++ b/basis/windows/time/time.factor @@ -28,8 +28,8 @@ IN: windows.time : windows-time>FILETIME ( n -- FILETIME ) "FILETIME" [ - [ >r HEX: ffffffff bitand r> set-FILETIME-dwLowDateTime ] 2keep - >r -32 shift r> set-FILETIME-dwHighDateTime + [ 32 bits set-FILETIME-dwLowDateTime ] 2keep + [ -32 shift ] dip set-FILETIME-dwHighDateTime ] keep ; : timestamp>FILETIME ( timestamp -- FILETIME/f ) From 1f517a1db8beb23539d1c96ac31229d8608a5f22 Mon Sep 17 00:00:00 2001 From: unknown Date: Sun, 14 Dec 2008 17:14:11 -0600 Subject: [PATCH 13/13] Fix using --- basis/windows/time/time.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/time/time.factor b/basis/windows/time/time.factor index 5ffc62680e..54a7a8e32a 100644 --- a/basis/windows/time/time.factor +++ b/basis/windows/time/time.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types kernel math windows windows.kernel32 -namespaces calendar ; +namespaces calendar math.bitwise ; IN: windows.time : >64bit ( lo hi -- n )