Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor
index 1ec18260cd56268410af8e442c1d07b497ff25bc..bcd38b172dc4b77cc8c2dad5755efa13f3b8a065 100644 (file)
--- 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/sequences/deep/authors.txt b/basis/sequences/deep/authors.txt
index f990dd0ed29ff1ada6887e18c53cbca2d40a2481..a07c427c988fa3d03d3581141483dfe092cdf39b 100644 (file)
--- 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 522b5ecdf95a5f60472ba3773b327d4f8a0ee98d..2d3260f4279154a8cddb834b99efd2076a9bcad0 100644 (file)
--- 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 db572681a16c72f56d9721fbf3dc06aa5bf7a4c3..244040d60ac316a7e523ab411ed3b18ab9b7dfeb 100644 (file)
--- 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

diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor
index f689ad08586627d403e4149a9646e8499ee422dd..0f16863a79fec3944961a027d635ccf05c55bd7d 100644 (file)
--- 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 525aca21ab6a54a497d7b6d3c33fe080f4943034..d6bab73017b7fc246babe117b05125fcda2a20ac 100755 (executable)
--- a/basis/ui/windows/windows.factor
+++ b/basis/ui/windows/windows.factor
@@ -172,10 +172,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 )

diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index 710feeec4d8c065c692c0465bbccb3f468639c9c..813d8315ac07f0a893c220e66e5e75fb49f37e6c 100755 (executable)
--- 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 5e23f8cc01e29df59b7dc96bc6239976d6fb88fe..54a7a8e32a82bf221df54997b746569c8ec092c6 100644 (file)
--- 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 )
@@ -28,8 +28,8 @@ IN: windows.time
 : windows-time>FILETIME ( n -- FILETIME )
     "FILETIME" <c-object>
     [
-        [ >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 )

diff --git a/extra/bank/bank.factor b/extra/bank/bank.factor
index a409c9781546b24bf1ea43d0ffc59e54d334f9f1..0f8b5581dfe582ff2d413527f2bd29a0b407e89d 100644 (file)
--- a/extra/bank/bank.factor
+++ b/extra/bank/bank.factor
@@ -20,7 +20,7 @@ C: <transaction> transaction
 : balance>> ( account -- balance ) transactions>> total ;
 
 : open-account ( name interest-rate interest-payment-day opening-date opening-balance -- account )
-    >r [ <account> ] keep r> "Account Opened" <transaction> >>transaction ;
+    [ [ <account> ] keep ] dip "Account Opened" <transaction> >>transaction ;
 
 : daily-rate ( yearly-rate day -- daily-rate )
     days-in-year / ;
@@ -56,7 +56,7 @@ C: <transaction> 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 ;

diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor
index b480c18913200d47f76145dd31222cfc68a8c0a2..62103bf5103fa159346fe53d616fc6c8977d0082 100755 (executable)
--- 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 ;

diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor
index a18bb31874730c4a5aed7c218efa73a77f175332..abe830c3faa20d4b643076b6c9bfad3e9e4617fd 100755 (executable)
--- 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' )

diff --git a/extra/namespaces/lib/lib.factor b/extra/namespaces/lib/lib.factor
index ae0887e45a5a10a854dcc587197862e99b708a88..dfa4df245c88c008a2b3bf15cffea8acc68cc712 100755 (executable)
--- 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 ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor
index 5ffdf67753e157c88fb6efabd4c87a5a133c30b0..978587c685d8aa8beb208014daa478aa64fa1764 100644 (file)
--- 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> <repetition> concat %
+        [ /mod swap ] dip <repetition> 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

diff --git a/extra/slides/lib.factor b/extra/slides/lib.factor
deleted file mode 100755 (executable)
index f9708b3..0000000
--- 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

diff --git a/extra/state-machine/state-machine.factor b/extra/state-machine/state-machine.factor
index 37e12a6993eb67a8d96d3368c8ef2d2a6fcefb1c..18c37209274eb401792926b5fe5f7ea394390d51 100755 (executable)
--- 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 ] <array> 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:

diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor
index b71b831ca6068ba922cf25670c883f2020cf422e..4b6d516369f82fd325803d161e32d65716092a2d 100644 (file)
--- 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 - ;

diff --git a/extra/units/units.factor b/extra/units/units.factor
index 02005fcd1f6c4143f2dc928a0c817204d48383ac..b8e3f45a16eca370ff3ed7c63f1689c5dcd0252f 100755 (executable)
--- 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 ;