From 763a45cc67377f1c03a5ab348b084eb1f14aab30 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 7 Jul 2008 12:14:07 -0500 Subject: [PATCH 01/13] Fix mmap on windows --- extra/io/windows/privileges/privileges.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/io/windows/privileges/privileges.factor b/extra/io/windows/privileges/privileges.factor index 144c799912..e169bdf12f 100755 --- a/extra/io/windows/privileges/privileges.factor +++ b/extra/io/windows/privileges/privileges.factor @@ -1,4 +1,5 @@ -USING: io.backend kernel continuations sequences ; +USING: io.backend kernel continuations sequences +system vocabs.loader combinators ; IN: io.windows.privileges HOOK: set-privilege io-backend ( name ? -- ) inline @@ -6,3 +7,8 @@ HOOK: set-privilege io-backend ( name ? -- ) inline : with-privileges ( seq quot -- ) over [ [ t set-privilege ] each ] curry compose swap [ [ f set-privilege ] each ] curry [ ] cleanup ; inline + +{ + { [ os winnt? ] [ "io.windows.nt.privileges" require ] } + { [ os wince? ] [ "io.windows.ce.privileges" require ] } +} cond From 0051a50b75804799677c286f65e6f3c90f8899ac Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Mon, 7 Jul 2008 19:36:33 -0500 Subject: [PATCH 02/13] Move general shufflers and combinators into generalizations, move narray there too --- core/bootstrap/primitives.factor | 2 +- core/debugger/debugger.factor | 2 +- core/sequences/sequences-docs.factor | 4 +- core/sequences/sequences.factor | 12 ++ extra/arrays/lib/authors.txt | 1 - extra/arrays/lib/lib.factor | 10 -- extra/arrays/lib/summary.txt | 1 - extra/arrays/lib/tags.txt | 1 - extra/bake/bake.factor | 2 +- extra/bake/fry/fry-tests.factor | 2 +- extra/bitfields/bitfields.factor | 2 +- extra/combinators/cleave/cleave.factor | 2 +- extra/combinators/lib/lib-docs.factor | 43 ------ extra/combinators/lib/lib-tests.factor | 8 -- extra/combinators/lib/lib.factor | 22 +-- .../short-circuit/short-circuit.factor | 2 +- extra/descriptive/descriptive.factor | 2 +- .../generalizations-docs.factor | 136 ++++++++++++++++++ .../generalizations-tests.factor | 32 +++++ extra/generalizations/generalizations.factor | 56 ++++++++ extra/html/parser/analyzer/analyzer.factor | 4 +- extra/inverse/inverse.factor | 4 +- extra/koszul/koszul.factor | 12 +- extra/logging/logging.factor | 2 +- extra/math/blas/matrices/matrices.factor | 3 +- extra/math/blas/vectors/vectors.factor | 2 +- extra/math/vectors/vectors.factor | 2 +- extra/mortar/mortar.factor | 2 +- extra/multi-methods/multi-methods.factor | 2 +- extra/processing/processing.factor | 2 +- extra/reports/noise/noise.factor | 4 +- extra/sequences/lib/lib.factor | 18 +-- extra/shuffle/authors.txt | 2 - extra/shuffle/shuffle-docs.factor | 84 ----------- extra/shuffle/shuffle-tests.factor | 25 ---- extra/shuffle/shuffle.factor | 39 ----- extra/shuffle/summary.txt | 1 - extra/shuffle/tags.txt | 1 - extra/spheres/spheres.factor | 2 +- extra/springies/springies.factor | 2 +- extra/tools/memory/memory.factor | 4 +- extra/unix/unix.factor | 2 +- extra/windows/com/com-tests.factor | 2 +- extra/windows/com/syntax/syntax.factor | 4 +- extra/windows/com/wrapper/wrapper.factor | 2 +- extra/windows/user32/user32.factor | 2 +- 46 files changed, 279 insertions(+), 292 deletions(-) delete mode 100755 extra/arrays/lib/authors.txt delete mode 100644 extra/arrays/lib/lib.factor delete mode 100644 extra/arrays/lib/summary.txt delete mode 100644 extra/arrays/lib/tags.txt mode change 100644 => 100755 extra/bake/bake.factor mode change 100644 => 100755 extra/bitfields/bitfields.factor mode change 100644 => 100755 extra/combinators/cleave/cleave.factor mode change 100644 => 100755 extra/combinators/short-circuit/short-circuit.factor create mode 100755 extra/generalizations/generalizations-docs.factor create mode 100755 extra/generalizations/generalizations-tests.factor create mode 100755 extra/generalizations/generalizations.factor mode change 100644 => 100755 extra/math/blas/matrices/matrices.factor mode change 100644 => 100755 extra/math/blas/vectors/vectors.factor mode change 100644 => 100755 extra/mortar/mortar.factor mode change 100644 => 100755 extra/processing/processing.factor delete mode 100644 extra/shuffle/authors.txt delete mode 100755 extra/shuffle/shuffle-docs.factor delete mode 100755 extra/shuffle/shuffle-tests.factor delete mode 100644 extra/shuffle/shuffle.factor delete mode 100644 extra/shuffle/summary.txt delete mode 100644 extra/shuffle/tags.txt mode change 100644 => 100755 extra/spheres/spheres.factor mode change 100644 => 100755 extra/springies/springies.factor mode change 100644 => 100755 extra/tools/memory/memory.factor diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 235f3894a1..6498dfde60 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -512,7 +512,7 @@ tuple { "unimplemented" "kernel.private" } { "gc-reset" "memory" } } -dup length [ >r first2 r> make-primitive ] 2each +[ >r first2 r> make-primitive ] each-index ! Bump build number "build" "kernel" create build 1+ 1quotation define diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index f5316b0858..6759c43094 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -52,7 +52,7 @@ M: string error. print ; nl "The following restarts are available:" print nl - dup length [ restart. ] 2each + [ restart. ] each-index ] if ; : print-error ( error -- ) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index dc8d7b9789..86fd9be3d7 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -43,8 +43,8 @@ ARTICLE: "sequences-integers" "Integer sequences and counted loops" $nl "For example, the " { $link each } " combinator, given an integer, simply calls a quotation that number of times, pushing a counter on each iteration that ranges from 0 up to that integer:" { $example "3 [ . ] each" "0\n1\n2" } -"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link 2each } ":" -{ $example "{ \"a\" \"b\" \"c\" } dup length [\n \"Index: \" write . \"Element: \" write .\n] 2each" "Index: 0\nElement: \"a\"\nIndex: 1\nElement: \"b\"\nIndex: 2\nElement: \"c\"" } +"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link each-index } ", " { $link map-index } " and " { $link reduce-index } "." +$nl "Combinators that produce new sequences, such as " { $link map } ", will output an array if the input is an integer." ; ARTICLE: "sequences-access" "Accessing sequence elements" diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 7560c8f73e..1c6b96d0d5 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -426,6 +426,18 @@ PRIVATE> : follow ( obj quot -- seq ) >r [ dup ] r> [ keep ] curry [ ] unfold nip ; inline +: prepare-index ( seq quot -- seq n quot ) + >r dup length r> ; inline + +: each-index ( seq quot -- ) + prepare-index 2each ; inline + +: map-index ( seq quot -- ) + prepare-index 2map ; inline + +: reduce-index ( seq identity quot -- ) + swapd each-index ; inline + : index ( obj seq -- n ) [ = ] with find drop ; diff --git a/extra/arrays/lib/authors.txt b/extra/arrays/lib/authors.txt deleted file mode 100755 index 6cfd5da273..0000000000 --- a/extra/arrays/lib/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Eduardo Cavazos diff --git a/extra/arrays/lib/lib.factor b/extra/arrays/lib/lib.factor deleted file mode 100644 index 6530e65ed6..0000000000 --- a/extra/arrays/lib/lib.factor +++ /dev/null @@ -1,10 +0,0 @@ - -USING: kernel arrays sequences sequences.private macros ; - -IN: arrays.lib - -MACRO: narray ( n -- quot ) - dup [ f ] curry - swap [ - [ swap [ set-nth-unsafe ] keep ] curry - ] map concat append ; diff --git a/extra/arrays/lib/summary.txt b/extra/arrays/lib/summary.txt deleted file mode 100644 index 5ecd994103..0000000000 --- a/extra/arrays/lib/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Non-core array words diff --git a/extra/arrays/lib/tags.txt b/extra/arrays/lib/tags.txt deleted file mode 100644 index 42d711b32b..0000000000 --- a/extra/arrays/lib/tags.txt +++ /dev/null @@ -1 +0,0 @@ -collections diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor old mode 100644 new mode 100755 index 4ce7bfb586..db77d92720 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -1,7 +1,7 @@ USING: kernel parser namespaces sequences quotations arrays vectors splitting words math - macros arrays.lib combinators.lib combinators.conditional newfx ; + macros generalizations combinators.lib combinators.conditional newfx ; IN: bake diff --git a/extra/bake/fry/fry-tests.factor b/extra/bake/fry/fry-tests.factor index 289e1b12fe..13202a78f5 100755 --- a/extra/bake/fry/fry-tests.factor +++ b/extra/bake/fry/fry-tests.factor @@ -1,6 +1,6 @@ USING: tools.test math prettyprint kernel io arrays vectors sequences - arrays.lib bake bake.fry ; + generalizations bake bake.fry ; IN: bake.fry.tests diff --git a/extra/bitfields/bitfields.factor b/extra/bitfields/bitfields.factor old mode 100644 new mode 100755 index 410fd4bdec..76e8d7883d --- a/extra/bitfields/bitfields.factor +++ b/extra/bitfields/bitfields.factor @@ -1,6 +1,6 @@ USING: parser lexer kernel math sequences namespaces assocs summary words splitting math.parser arrays sequences.next mirrors -shuffle compiler.units ; +generalizations compiler.units ; IN: bitfields ! Example: diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor old mode 100644 new mode 100755 index 9b8a790760..f5aeeff619 --- a/extra/combinators/cleave/cleave.factor +++ b/extra/combinators/cleave/cleave.factor @@ -1,6 +1,6 @@ USING: kernel combinators words quotations arrays sequences locals macros - shuffle combinators.lib arrays.lib fry ; + shuffle combinators.lib generalizations fry ; IN: combinators.cleave diff --git a/extra/combinators/lib/lib-docs.factor b/extra/combinators/lib/lib-docs.factor index ccb1fca9a1..fe2f3556ef 100755 --- a/extra/combinators/lib/lib-docs.factor +++ b/extra/combinators/lib/lib-docs.factor @@ -11,46 +11,3 @@ HELP: generate "[ 20 random-prime ] [ 4 mod 3 = ] generate ." "526367" } ; - -HELP: ndip -{ $values { "quot" quotation } { "n" number } } -{ $description "A generalisation of " { $link dip } " that can work " -"for any stack depth. The quotation will be called with a stack that " -"has 'n' items removed first. The 'n' items are then put back on the " -"stack. The quotation can consume and produce any number of items." -} -{ $examples - { $example "USING: combinators.lib kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" } - { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" } -} -{ $see-also dip 2dip } ; - -HELP: nslip -{ $values { "n" number } } -{ $description "A generalisation of " { $link slip } " that can work " -"for any stack depth. The first " { $snippet "n" } " items after the quotation will be " -"removed from the stack, the quotation called, and the items restored." -} -{ $examples - { $example "USING: combinators.lib prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" } -} -{ $see-also slip nkeep } ; - -HELP: nkeep -{ $values { "quot" quotation } { "n" number } } -{ $description "A generalisation of " { $link keep } " that can work " -"for any stack depth. The first " { $snippet "n" } " items after the quotation will be " -"saved, the quotation called, and the items restored." -} -{ $examples - { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" } -} -{ $see-also keep nslip } ; - -! HELP: && -! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } -! { $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ; - -! HELP: || -! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } -! { $description "Calls each quotation in turn; outputs " { $link t } " if one of the quotations output " { $link t } ", otherwise outputs " { $link f } ". As soon as a quotation outputs " { $link t } ", evaluation stops and subsequent quotations are not called." } ; diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index e511e88fcc..89d3ed7f7d 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -5,14 +5,6 @@ IN: combinators.lib.tests [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test [ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test -[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer -{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test -[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer -{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test -[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test -[ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test -[ [ dup 2^ 2array ] 5 napply ] must-infer - [ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test [ { "foo" "xbarx" } ] diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 3fab4f62ae..4af12a9ad6 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -4,7 +4,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel combinators fry namespaces quotations hashtables sequences assocs arrays inference effects math math.ranges -arrays.lib shuffle macros continuations locals ; +generalizations macros continuations locals ; IN: combinators.lib @@ -12,30 +12,10 @@ IN: combinators.lib ! Generalized versions of core combinators ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -MACRO: ndip ( quot n -- ) dup saver -rot restorer 3append ; - -MACRO: nslip ( n -- ) dup saver [ call ] rot restorer 3append ; - : 4slip ( quot a b c d -- a b c d ) 4 nslip ; inline -MACRO: nkeep ( n -- ) - [ ] [ 1+ ] [ ] tri - '[ [ , ndup ] dip , -nrot , nslip ] ; - : 4keep ( w x y z quot -- w x y z ) 4 nkeep ; inline -MACRO: ncurry ( n -- ) [ curry ] n*quot ; - -MACRO:: nwith ( quot n -- ) - [let | n' [ n 1+ ] | - [ n' -nrot [ n' nrot quot call ] n ncurry ] ] ; - -MACRO: napply ( n -- ) - 2 [a,b] - [ [ 1- ] [ ] bi - '[ , ntuck , nslip ] ] - map concat >quotation [ call ] append ; - : 2with ( param1 param2 obj quot -- obj curry ) with with ; inline diff --git a/extra/combinators/short-circuit/short-circuit.factor b/extra/combinators/short-circuit/short-circuit.factor old mode 100644 new mode 100755 index c74a2ca4fb..a484e09de1 --- a/extra/combinators/short-circuit/short-circuit.factor +++ b/extra/combinators/short-circuit/short-circuit.factor @@ -1,6 +1,6 @@ USING: kernel combinators quotations arrays sequences assocs - locals shuffle macros fry ; + locals generalizations macros fry ; IN: combinators.short-circuit diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index 3b55aa0521..4b40747e9f 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -1,6 +1,6 @@ USING: words kernel sequences combinators.lib locals locals.private accessors parser namespaces continuations -summary definitions arrays.lib arrays ; +summary definitions generalizations arrays ; IN: descriptive ERROR: descriptive-error args underlying word ; diff --git a/extra/generalizations/generalizations-docs.factor b/extra/generalizations/generalizations-docs.factor new file mode 100755 index 0000000000..decabdc89d --- /dev/null +++ b/extra/generalizations/generalizations-docs.factor @@ -0,0 +1,136 @@ +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup kernel sequences quotations +math ; +IN: generalizations + +HELP: npick +{ $values { "n" integer } } +{ $description "A generalization of " { $link dup } ", " +{ $link over } " and " { $link pick } " that can work " +"for any stack depth. The nth item down the stack will be copied and " +"placed on the top of the stack." +} +{ $examples + { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" } +} +{ $see-also dup over pick } ; + +HELP: ndup +{ $values { "n" integer } } +{ $description "A generalization of " { $link dup } ", " +{ $link 2dup } " and " { $link 3dup } " that can work " +"for any number of items. The n topmost items on the stack will be copied and " +"placed on the top of the stack." +} +{ $examples + { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" } +} +{ $see-also dup 2dup 3dup } ; + +HELP: nnip +{ $values { "n" integer } } +{ $description "A generalization of " { $link nip } " and " { $link 2nip } +" that can work " +"for any number of items." +} +{ $examples + { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 nnip .s" "4" } +} +{ $see-also nip 2nip } ; + +HELP: ndrop +{ $values { "n" integer } } +{ $description "A generalization of " { $link drop } +" that can work " +"for any number of items." +} +{ $examples + { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 ndrop .s" "1" } +} +{ $see-also drop 2drop 3drop } ; + +HELP: nrot +{ $values { "n" integer } } +{ $description "A generalization of " { $link rot } " that works for any " +"number of items on the stack. " +} +{ $examples + { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" } +} +{ $see-also rot -nrot } ; + +HELP: -nrot +{ $values { "n" integer } } +{ $description "A generalization of " { $link -rot } " that works for any " +"number of items on the stack. " +} +{ $examples + { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" } +} +{ $see-also rot nrot } ; + +HELP: nrev +{ $values { "n" integer } } +{ $description "A generalization of " { $link spin } " that reverses any number of items at the top of the stack." +} +{ $examples + { $example "USING: prettyprint generalizations ;" "1 2 3 4 nrev .s" "4\n3\n2\n1\n" } +} +{ $see-also rot nrot } ; + +HELP: ndip +{ $values { "quot" quotation } { "n" number } } +{ $description "A generalization of " { $link dip } " that can work " +"for any stack depth. The quotation will be called with a stack that " +"has 'n' items removed first. The 'n' items are then put back on the " +"stack. The quotation can consume and produce any number of items." +} +{ $examples + { $example "USING: combinators.lib kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" } + { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" } +} +{ $see-also dip 2dip } ; + +HELP: nslip +{ $values { "n" number } } +{ $description "A generalization of " { $link slip } " that can work " +"for any stack depth. The first " { $snippet "n" } " items after the quotation will be " +"removed from the stack, the quotation called, and the items restored." +} +{ $examples + { $example "USING: combinators.lib prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" } +} +{ $see-also slip nkeep } ; + +HELP: nkeep +{ $values { "quot" quotation } { "n" number } } +{ $description "A generalization of " { $link keep } " that can work " +"for any stack depth. The first " { $snippet "n" } " items after the quotation will be " +"saved, the quotation called, and the items restored." +} +{ $examples + { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" } +} +{ $see-also keep nslip } ; + +ARTICLE: "generalizations" "Generalized shuffle words and combinators" +"A number of stack shuffling words and combinators for use in " +"macros where the arity of the input quotations depends on an " +"input parameter." +{ $subsection narray } +{ $subsection ndup } +{ $subsection npick } +{ $subsection nrot } +{ $subsection -nrot } +{ $subsection nnip } +{ $subsection ndrop } +{ $subsection nrev } +{ $subsection ndip } +{ $subsection nslip } +{ $subsection nkeep } +{ $subsection ncurry } +{ $subsection nwith } +{ $subsection napply } ; + +ABOUT: "generalizations" diff --git a/extra/generalizations/generalizations-tests.factor b/extra/generalizations/generalizations-tests.factor new file mode 100755 index 0000000000..1210143094 --- /dev/null +++ b/extra/generalizations/generalizations-tests.factor @@ -0,0 +1,32 @@ +USING: tools.test generalizations kernel math arrays ; +IN: generalizations.tests + +{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test +{ 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test +{ 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test +{ 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test +[ 1 1 ndup ] must-infer +{ 1 1 } [ 1 1 ndup ] unit-test +{ 1 2 1 2 } [ 1 2 2 ndup ] unit-test +{ 1 2 3 1 2 3 } [ 1 2 3 3 ndup ] unit-test +{ 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4 ndup ] unit-test +[ 1 2 2 nrot ] must-infer +{ 2 1 } [ 1 2 2 nrot ] unit-test +{ 2 3 1 } [ 1 2 3 3 nrot ] unit-test +{ 2 3 4 1 } [ 1 2 3 4 4 nrot ] unit-test +[ 1 2 2 -nrot ] must-infer +{ 2 1 } [ 1 2 2 -nrot ] unit-test +{ 3 1 2 } [ 1 2 3 3 -nrot ] unit-test +{ 4 1 2 3 } [ 1 2 3 4 4 -nrot ] unit-test +[ 1 2 3 4 3 nnip ] must-infer +{ 4 } [ 1 2 3 4 3 nnip ] unit-test +[ 1 2 3 4 4 ndrop ] must-infer +{ 0 } [ 0 1 2 3 4 4 ndrop ] unit-test + +[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer +{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test +[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer +{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test +[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test +[ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test +[ [ dup 2^ 2array ] 5 napply ] must-infer diff --git a/extra/generalizations/generalizations.factor b/extra/generalizations/generalizations.factor new file mode 100755 index 0000000000..6cbb13518e --- /dev/null +++ b/extra/generalizations/generalizations.factor @@ -0,0 +1,56 @@ +! Copyright (C) 2007, 2008 Chris Double, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel sequences sequences.private namespaces math math.ranges +combinators macros quotations fry locals arrays ; +IN: generalizations + +MACRO: narray ( n -- quot ) + dup [ f ] curry + swap [ + [ swap [ set-nth-unsafe ] keep ] curry + ] map concat append ; + +MACRO: npick ( n -- ) + 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ; + +MACRO: ndup ( n -- ) + dup '[ , npick ] n*quot ; + +MACRO: nrot ( n -- ) + 1- dup saver swap [ r> swap ] n*quot append ; + +MACRO: -nrot ( n -- ) + 1- dup [ swap >r ] n*quot swap restorer append ; + +MACRO: ndrop ( n -- ) + [ drop ] n*quot ; + +: nnip ( n -- ) + swap >r ndrop r> ; inline + +MACRO: ntuck ( n -- ) + 2 + [ dupd -nrot ] curry ; + +MACRO: nrev ( n -- quot ) + 1 [a,b] [ '[ , -nrot ] ] map concat ; + +MACRO: ndip ( quot n -- ) + dup saver -rot restorer 3append ; + +MACRO: nslip ( n -- ) + dup saver [ call ] rot restorer 3append ; + +MACRO: nkeep ( n -- ) + [ ] [ 1+ ] [ ] tri + '[ [ , ndup ] dip , -nrot , nslip ] ; + +MACRO: ncurry ( n -- ) [ curry ] n*quot ; + +MACRO:: nwith ( quot n -- ) + [let | n' [ n 1+ ] | + [ n' -nrot [ n' nrot quot call ] n ncurry ] ] ; + +MACRO: napply ( n -- ) + 2 [a,b] + [ [ 1- ] keep '[ , ntuck , nslip ] ] + map concat >quotation [ call ] append ; diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index f6fccd42ec..dca727b9dc 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -1,6 +1,6 @@ USING: assocs html.parser kernel math sequences strings ascii -arrays shuffle unicode.case namespaces splitting http -sequences.lib accessors io combinators http.client urls ; +arrays generalizations shuffle unicode.case namespaces splitting +http sequences.lib accessors io combinators http.client urls ; IN: html.parser.analyzer TUPLE: link attributes clickable ; diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 4a35fbab24..5a8ef4c787 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007, 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel words summary slots quotations -sequences assocs math arrays inference effects shuffle +sequences assocs math arrays inference effects generalizations continuations debugger classes.tuple namespaces vectors bit-arrays byte-arrays strings sbufs math.functions macros -sequences.private combinators mirrors combinators.lib +sequences.private combinators mirrors combinators.short-circuit ; IN: inverse diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index 188cfaa1cf..37c2137433 100755 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -257,11 +257,11 @@ DEFER: (d) [ laplacian-kernel ] graded-laplacian ; : graded-basis. ( seq -- ) - dup length [ + [ "=== Degree " write pprint ": dimension " write dup length . [ alt. ] each - ] 2each ; + ] each-index ; : bigraded-triple ( u-deg z-deg bigraded-basis -- triple ) #! d: C(u,z) ---> C(u+2,z-1) @@ -289,11 +289,11 @@ DEFER: (d) [ laplacian-kernel ] bigraded-laplacian ; : bigraded-basis. ( seq -- ) - dup length [ + [ "=== U-degree " write . - dup length [ + [ " === Z-degree " write pprint ": dimension " write dup length . [ " " write alt. ] each - ] 2each - ] 2each ; + ] each-index + ] each-index ; diff --git a/extra/logging/logging.factor b/extra/logging/logging.factor index 37ea9ac507..78a3002906 100755 --- a/extra/logging/logging.factor +++ b/extra/logging/logging.factor @@ -3,7 +3,7 @@ USING: logging.server sequences namespaces concurrency.messaging words kernel arrays shuffle tools.annotations prettyprint.config prettyprint debugger io.streams.string -splitting continuations effects arrays.lib parser strings +splitting continuations effects generalizations parser strings quotations fry symbols accessors ; IN: logging diff --git a/extra/math/blas/matrices/matrices.factor b/extra/math/blas/matrices/matrices.factor old mode 100644 new mode 100755 index 99f20b432b..c07dfca76d --- a/extra/math/blas/matrices/matrices.factor +++ b/extra/math/blas/matrices/matrices.factor @@ -2,7 +2,8 @@ USING: accessors alien alien.c-types arrays byte-arrays combinators combinators.lib combinators.short-circuit fry kernel locals macros math math.blas.cblas math.blas.vectors math.blas.vectors.private math.complex math.functions math.order multi-methods qualified -sequences sequences.merged sequences.private shuffle symbols ; +sequences sequences.merged sequences.private generalizations +shuffle symbols ; QUALIFIED: syntax IN: math.blas.matrices diff --git a/extra/math/blas/vectors/vectors.factor b/extra/math/blas/vectors/vectors.factor old mode 100644 new mode 100755 index 3c927318a6..18370f12c0 --- a/extra/math/blas/vectors/vectors.factor +++ b/extra/math/blas/vectors/vectors.factor @@ -1,7 +1,7 @@ USING: accessors alien alien.c-types arrays byte-arrays combinators combinators.short-circuit fry kernel macros math math.blas.cblas math.complex math.functions math.order multi-methods qualified -sequences sequences.private shuffle ; +sequences sequences.private generalizations ; QUALIFIED: syntax IN: math.blas.vectors diff --git a/extra/math/vectors/vectors.factor b/extra/math/vectors/vectors.factor index 5572a0cf53..b6ac459123 100755 --- a/extra/math/vectors/vectors.factor +++ b/extra/math/vectors/vectors.factor @@ -25,7 +25,7 @@ IN: math.vectors : normalize ( u -- v ) dup norm v/n ; : set-axis ( u v axis -- w ) - dup length [ >r zero? 2over ? r> swap nth ] 2map 2nip ; + [ >r zero? 2over ? r> swap nth ] map-index 2nip ; HINTS: vneg { array } ; HINTS: norm-sq { array } ; diff --git a/extra/mortar/mortar.factor b/extra/mortar/mortar.factor old mode 100644 new mode 100755 index 1b5b6f2393..5b7f3356c1 --- a/extra/mortar/mortar.factor +++ b/extra/mortar/mortar.factor @@ -1,6 +1,6 @@ USING: kernel io parser lexer words namespaces quotations arrays assocs sequences - splitting grouping math shuffle ; + splitting grouping math generalizations ; IN: mortar diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index c8128c33ee..69dca2affc 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences vectors classes classes.algebra combinators arrays words assocs parser namespaces definitions -prettyprint prettyprint.backend quotations arrays.lib +prettyprint prettyprint.backend quotations generalizations debugger io compiler.units kernel.private effects accessors hashtables sorting shuffle math.order sets ; IN: multi-methods diff --git a/extra/processing/processing.factor b/extra/processing/processing.factor old mode 100644 new mode 100755 index e089b15e7e..fb9f321f47 --- a/extra/processing/processing.factor +++ b/extra/processing/processing.factor @@ -1,7 +1,7 @@ USING: kernel namespaces threads combinators sequences arrays math math.functions math.ranges random - opengl.gl opengl.glu vars multi-methods shuffle + opengl.gl opengl.glu vars multi-methods generalizations shuffle ui ui.gestures ui.gadgets diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 32a43a4fb4..ff88abad61 100755 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -1,7 +1,7 @@ -USING: accessors assocs math kernel shuffle combinators.lib +USING: accessors assocs math kernel shuffle generalizations words quotations arrays combinators sequences math.vectors io.styles prettyprint vocabs sorting io generic locals.private -math.statistics math.order ; +math.statistics math.order combinators.lib ; IN: reports.noise : badness ( word -- n ) diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 1debe3f91b..3b54abfeab 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -4,7 +4,8 @@ USING: combinators.lib kernel sequences math namespaces assocs random sequences.private shuffle math.functions arrays math.parser math.private sorting strings ascii macros -assocs.lib quotations hashtables math.order locals ; +assocs.lib quotations hashtables math.order locals +generalizations ; IN: sequences.lib : each-withn ( seq quot n -- ) nwith each ; inline @@ -24,21 +25,6 @@ MACRO: firstn ( n -- ) concat >quotation [ drop ] compose ; -: prepare-index ( seq quot -- seq n quot ) - >r dup length r> ; inline - -: each-index ( seq quot -- ) - #! quot: ( elt index -- ) - prepare-index 2each ; inline - -: map-index ( seq quot -- ) - #! quot: ( elt index -- obj ) - prepare-index 2map ; inline - -: reduce-index ( seq identity quot -- ) - #! quot: ( prev elt index -- next ) - swapd each-index ; inline - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : each-percent ( seq quot -- ) diff --git a/extra/shuffle/authors.txt b/extra/shuffle/authors.txt deleted file mode 100644 index 26093b451b..0000000000 --- a/extra/shuffle/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Chris Double -Doug Coleman diff --git a/extra/shuffle/shuffle-docs.factor b/extra/shuffle/shuffle-docs.factor deleted file mode 100755 index 4caace3b00..0000000000 --- a/extra/shuffle/shuffle-docs.factor +++ /dev/null @@ -1,84 +0,0 @@ -! Copyright (C) 2007 Chris Double. -! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup kernel sequences ; -IN: shuffle - -HELP: npick -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link dup } ", " -{ $link over } " and " { $link pick } " that can work " -"for any stack depth. The nth item down the stack will be copied and " -"placed on the top of the stack." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" } -} -{ $see-also dup over pick } ; - -HELP: ndup -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link dup } ", " -{ $link 2dup } " and " { $link 3dup } " that can work " -"for any number of items. The n topmost items on the stack will be copied and " -"placed on the top of the stack." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" } -} -{ $see-also dup 2dup 3dup } ; - -HELP: nnip -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link nip } " and " { $link 2nip } -" that can work " -"for any number of items." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 nnip .s" "4" } -} -{ $see-also nip 2nip } ; - -HELP: ndrop -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link drop } -" that can work " -"for any number of items." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 ndrop .s" "1" } -} -{ $see-also drop 2drop 3drop } ; - -HELP: nrot -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link rot } " that works for any " -"number of items on the stack. " -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" } -} -{ $see-also rot -nrot } ; - -HELP: -nrot -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link -rot } " that works for any " -"number of items on the stack. " -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" } -} -{ $see-also rot nrot } ; - -ARTICLE: { "shuffle" "overview" } "Extra shuffle words" -"A number of stack shuffling words for those rare times when you " -"need to deal with tricky stack situations and can't refactor the " -"code to work around it." -{ $subsection ndup } -{ $subsection npick } -{ $subsection nrot } -{ $subsection -nrot } -{ $subsection nnip } -{ $subsection ndrop } ; - -IN: shuffle -ABOUT: { "shuffle" "overview" } \ No newline at end of file diff --git a/extra/shuffle/shuffle-tests.factor b/extra/shuffle/shuffle-tests.factor deleted file mode 100755 index 9f2b8e01a9..0000000000 --- a/extra/shuffle/shuffle-tests.factor +++ /dev/null @@ -1,25 +0,0 @@ -USING: arrays shuffle kernel math tools.test inference words ; - -[ 8 ] [ 5 6 7 8 3nip ] unit-test -{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test -{ 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test -{ 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test -{ 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test -{ t } [ [ 1 1 ndup ] infer >boolean ] unit-test -{ 1 1 } [ 1 1 ndup ] unit-test -{ 1 2 1 2 } [ 1 2 2 ndup ] unit-test -{ 1 2 3 1 2 3 } [ 1 2 3 3 ndup ] unit-test -{ 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4 ndup ] unit-test -{ t } [ [ 1 2 2 nrot ] infer >boolean ] unit-test -{ 2 1 } [ 1 2 2 nrot ] unit-test -{ 2 3 1 } [ 1 2 3 3 nrot ] unit-test -{ 2 3 4 1 } [ 1 2 3 4 4 nrot ] unit-test -{ t } [ [ 1 2 2 -nrot ] infer >boolean ] unit-test -{ 2 1 } [ 1 2 2 -nrot ] unit-test -{ 3 1 2 } [ 1 2 3 3 -nrot ] unit-test -{ 4 1 2 3 } [ 1 2 3 4 4 -nrot ] unit-test -{ t } [ [ 1 2 3 4 3 nnip ] infer >boolean ] unit-test -{ 4 } [ 1 2 3 4 3 nnip ] unit-test -{ t } [ [ 1 2 3 4 4 ndrop ] infer >boolean ] unit-test -{ 0 } [ 0 1 2 3 4 4 ndrop ] unit-test -[ 3 1 2 3 ] [ 1 2 3 tuckd ] unit-test diff --git a/extra/shuffle/shuffle.factor b/extra/shuffle/shuffle.factor deleted file mode 100644 index 2366d15cff..0000000000 --- a/extra/shuffle/shuffle.factor +++ /dev/null @@ -1,39 +0,0 @@ -! Copyright (C) 2007 Chris Double, Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences namespaces math inference.transforms - combinators macros quotations math.ranges fry ; - -IN: shuffle - -MACRO: npick ( n -- ) 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ; - -MACRO: ndup ( n -- ) dup [ npick ] curry n*quot ; - -MACRO: nrot ( n -- ) 1- dup saver swap [ r> swap ] n*quot append ; - -MACRO: -nrot ( n -- ) 1- dup [ swap >r ] n*quot swap restorer append ; - -MACRO: ndrop ( n -- ) [ drop ] n*quot ; - -: nnip ( n -- ) swap >r ndrop r> ; inline - -MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ; - -: 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline - -: nipd ( a b c -- b c ) rot drop ; inline - -: 3nip ( a b c d -- d ) 3 nnip ; inline - -: 4nip ( a b c d e -- e ) 4 nnip ; inline - -: 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline - -: 4drop ( a b c d -- ) 3drop drop ; inline - -: tuckd ( x y z -- z x y z ) 2 ntuck ; inline - -MACRO: nrev ( n -- quot ) - [ 1+ ] map - reverse - [ [ -nrot ] curry ] map concat ; diff --git a/extra/shuffle/summary.txt b/extra/shuffle/summary.txt deleted file mode 100644 index 12c22b8ae0..0000000000 --- a/extra/shuffle/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Additional shuffle words diff --git a/extra/shuffle/tags.txt b/extra/shuffle/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/extra/shuffle/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor old mode 100644 new mode 100755 index 9d06987bcd..dff7313eec --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -1,6 +1,6 @@ USING: kernel opengl.demo-support opengl.gl opengl.shaders opengl.framebuffers opengl multiline ui.gadgets accessors sequences ui.render ui math -arrays arrays.lib combinators ; +arrays generalizations combinators ; IN: spheres STRING: plane-vertex-shader diff --git a/extra/springies/springies.factor b/extra/springies/springies.factor old mode 100644 new mode 100755 index cd6e1a7cfb..1856115863 --- a/extra/springies/springies.factor +++ b/extra/springies/springies.factor @@ -1,6 +1,6 @@ USING: kernel combinators sequences arrays math math.vectors - shuffle vars ; + generalizations vars ; IN: springies diff --git a/extra/tools/memory/memory.factor b/extra/tools/memory/memory.factor old mode 100644 new mode 100755 index 83da7f22a8..f61694da78 --- a/extra/tools/memory/memory.factor +++ b/extra/tools/memory/memory.factor @@ -33,10 +33,10 @@ IN: tools.memory [ [ write-cell ] each ] with-row ; : (data-room.) ( -- ) - data-room 2 dup length [ + data-room 2 [ [ first2 ] [ number>string "Generation " prepend ] bi* write-total/used/free - ] 2each + ] each-index "Decks" write-total "Cards" write-total ; diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 07eb2950fa..083700493d 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -4,7 +4,7 @@ USING: alien alien.c-types alien.syntax kernel libc structs sequences continuations byte-arrays strings math namespaces system combinators vocabs.loader qualified - accessors inference macros locals shuffle arrays.lib + accessors inference macros locals generalizations unix.types debugger io prettyprint ; IN: unix diff --git a/extra/windows/com/com-tests.factor b/extra/windows/com/com-tests.factor index c04fd8f544..394bec2dfb 100755 --- a/extra/windows/com/com-tests.factor +++ b/extra/windows/com/com-tests.factor @@ -1,5 +1,5 @@ USING: kernel windows.com windows.com.syntax windows.ole32 -alien alien.syntax tools.test libc alien.c-types arrays.lib +alien alien.syntax tools.test libc alien.c-types namespaces arrays continuations accessors math windows.com.wrapper windows.com.wrapper.private destructors effects ; IN: windows.com.tests diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor index e0ea65e8be..dd7d058a77 100755 --- a/extra/windows/com/syntax/syntax.factor +++ b/extra/windows/com/syntax/syntax.factor @@ -1,6 +1,6 @@ USING: alien alien.c-types effects kernel windows.ole32 -parser lexer splitting grouping sequences.lib sequences namespaces -assocs quotations shuffle accessors words macros alien.syntax +parser lexer splitting grouping sequences namespaces +assocs quotations generalizations accessors words macros alien.syntax fry arrays ; IN: windows.com.syntax diff --git a/extra/windows/com/wrapper/wrapper.factor b/extra/windows/com/wrapper/wrapper.factor index 266439ad79..79a945e7de 100755 --- a/extra/windows/com/wrapper/wrapper.factor +++ b/extra/windows/com/wrapper/wrapper.factor @@ -1,6 +1,6 @@ USING: alien alien.c-types windows.com.syntax windows.com.syntax.private windows.com continuations kernel -sequences.lib namespaces windows.ole32 libc vocabs +namespaces windows.ole32 libc vocabs assocs accessors arrays sequences quotations combinators math words compiler.units destructors fry math.parser combinators.lib ; diff --git a/extra/windows/user32/user32.factor b/extra/windows/user32/user32.factor index 49a04dcb48..1c1df52da8 100755 --- a/extra/windows/user32/user32.factor +++ b/extra/windows/user32/user32.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.syntax parser namespaces kernel math -windows.types shuffle math.bitfields alias ; +windows.types generalizations math.bitfields alias ; IN: windows.user32 ! HKL for ActivateKeyboardLayout From 400cde1fe638a380966a6c6751d04a98323d5b64 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Tue, 8 Jul 2008 10:18:23 -0500 Subject: [PATCH 03/13] Fix load error --- extra/windows/com/wrapper/wrapper.factor | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/extra/windows/com/wrapper/wrapper.factor b/extra/windows/com/wrapper/wrapper.factor index 79a945e7de..40c61dfbe7 100755 --- a/extra/windows/com/wrapper/wrapper.factor +++ b/extra/windows/com/wrapper/wrapper.factor @@ -1,9 +1,8 @@ USING: alien alien.c-types windows.com.syntax windows.com.syntax.private windows.com continuations kernel -namespaces windows.ole32 libc vocabs -assocs accessors arrays sequences quotations combinators -math words compiler.units destructors fry -math.parser combinators.lib ; +namespaces windows.ole32 libc vocabs assocs accessors arrays +sequences quotations combinators math words compiler.units +destructors fry math.parser generalizations ; IN: windows.com.wrapper TUPLE: com-wrapper vtbls disposed ; From 267a24c0ded8cb87e7c0824ebbc513d358f674ee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 12:34:52 -0500 Subject: [PATCH 04/13] Oops --- extra/shuffle/authors.txt | 2 + extra/shuffle/shuffle-docs.factor | 84 ++++++++++++++++++++++++++++++ extra/shuffle/shuffle-tests.factor | 25 +++++++++ extra/shuffle/shuffle.factor | 39 ++++++++++++++ extra/shuffle/summary.txt | 1 + extra/shuffle/tags.txt | 1 + 6 files changed, 152 insertions(+) create mode 100644 extra/shuffle/authors.txt create mode 100755 extra/shuffle/shuffle-docs.factor create mode 100755 extra/shuffle/shuffle-tests.factor create mode 100644 extra/shuffle/shuffle.factor create mode 100644 extra/shuffle/summary.txt create mode 100644 extra/shuffle/tags.txt diff --git a/extra/shuffle/authors.txt b/extra/shuffle/authors.txt new file mode 100644 index 0000000000..26093b451b --- /dev/null +++ b/extra/shuffle/authors.txt @@ -0,0 +1,2 @@ +Chris Double +Doug Coleman diff --git a/extra/shuffle/shuffle-docs.factor b/extra/shuffle/shuffle-docs.factor new file mode 100755 index 0000000000..4caace3b00 --- /dev/null +++ b/extra/shuffle/shuffle-docs.factor @@ -0,0 +1,84 @@ +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup kernel sequences ; +IN: shuffle + +HELP: npick +{ $values { "n" "a number" } } +{ $description "A generalisation of " { $link dup } ", " +{ $link over } " and " { $link pick } " that can work " +"for any stack depth. The nth item down the stack will be copied and " +"placed on the top of the stack." +} +{ $examples + { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" } +} +{ $see-also dup over pick } ; + +HELP: ndup +{ $values { "n" "a number" } } +{ $description "A generalisation of " { $link dup } ", " +{ $link 2dup } " and " { $link 3dup } " that can work " +"for any number of items. The n topmost items on the stack will be copied and " +"placed on the top of the stack." +} +{ $examples + { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" } +} +{ $see-also dup 2dup 3dup } ; + +HELP: nnip +{ $values { "n" "a number" } } +{ $description "A generalisation of " { $link nip } " and " { $link 2nip } +" that can work " +"for any number of items." +} +{ $examples + { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 nnip .s" "4" } +} +{ $see-also nip 2nip } ; + +HELP: ndrop +{ $values { "n" "a number" } } +{ $description "A generalisation of " { $link drop } +" that can work " +"for any number of items." +} +{ $examples + { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 ndrop .s" "1" } +} +{ $see-also drop 2drop 3drop } ; + +HELP: nrot +{ $values { "n" "a number" } } +{ $description "A generalisation of " { $link rot } " that works for any " +"number of items on the stack. " +} +{ $examples + { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" } +} +{ $see-also rot -nrot } ; + +HELP: -nrot +{ $values { "n" "a number" } } +{ $description "A generalisation of " { $link -rot } " that works for any " +"number of items on the stack. " +} +{ $examples + { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" } +} +{ $see-also rot nrot } ; + +ARTICLE: { "shuffle" "overview" } "Extra shuffle words" +"A number of stack shuffling words for those rare times when you " +"need to deal with tricky stack situations and can't refactor the " +"code to work around it." +{ $subsection ndup } +{ $subsection npick } +{ $subsection nrot } +{ $subsection -nrot } +{ $subsection nnip } +{ $subsection ndrop } ; + +IN: shuffle +ABOUT: { "shuffle" "overview" } \ No newline at end of file diff --git a/extra/shuffle/shuffle-tests.factor b/extra/shuffle/shuffle-tests.factor new file mode 100755 index 0000000000..9f2b8e01a9 --- /dev/null +++ b/extra/shuffle/shuffle-tests.factor @@ -0,0 +1,25 @@ +USING: arrays shuffle kernel math tools.test inference words ; + +[ 8 ] [ 5 6 7 8 3nip ] unit-test +{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test +{ 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test +{ 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test +{ 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test +{ t } [ [ 1 1 ndup ] infer >boolean ] unit-test +{ 1 1 } [ 1 1 ndup ] unit-test +{ 1 2 1 2 } [ 1 2 2 ndup ] unit-test +{ 1 2 3 1 2 3 } [ 1 2 3 3 ndup ] unit-test +{ 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4 ndup ] unit-test +{ t } [ [ 1 2 2 nrot ] infer >boolean ] unit-test +{ 2 1 } [ 1 2 2 nrot ] unit-test +{ 2 3 1 } [ 1 2 3 3 nrot ] unit-test +{ 2 3 4 1 } [ 1 2 3 4 4 nrot ] unit-test +{ t } [ [ 1 2 2 -nrot ] infer >boolean ] unit-test +{ 2 1 } [ 1 2 2 -nrot ] unit-test +{ 3 1 2 } [ 1 2 3 3 -nrot ] unit-test +{ 4 1 2 3 } [ 1 2 3 4 4 -nrot ] unit-test +{ t } [ [ 1 2 3 4 3 nnip ] infer >boolean ] unit-test +{ 4 } [ 1 2 3 4 3 nnip ] unit-test +{ t } [ [ 1 2 3 4 4 ndrop ] infer >boolean ] unit-test +{ 0 } [ 0 1 2 3 4 4 ndrop ] unit-test +[ 3 1 2 3 ] [ 1 2 3 tuckd ] unit-test diff --git a/extra/shuffle/shuffle.factor b/extra/shuffle/shuffle.factor new file mode 100644 index 0000000000..2366d15cff --- /dev/null +++ b/extra/shuffle/shuffle.factor @@ -0,0 +1,39 @@ +! Copyright (C) 2007 Chris Double, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel sequences namespaces math inference.transforms + combinators macros quotations math.ranges fry ; + +IN: shuffle + +MACRO: npick ( n -- ) 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ; + +MACRO: ndup ( n -- ) dup [ npick ] curry n*quot ; + +MACRO: nrot ( n -- ) 1- dup saver swap [ r> swap ] n*quot append ; + +MACRO: -nrot ( n -- ) 1- dup [ swap >r ] n*quot swap restorer append ; + +MACRO: ndrop ( n -- ) [ drop ] n*quot ; + +: nnip ( n -- ) swap >r ndrop r> ; inline + +MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ; + +: 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline + +: nipd ( a b c -- b c ) rot drop ; inline + +: 3nip ( a b c d -- d ) 3 nnip ; inline + +: 4nip ( a b c d e -- e ) 4 nnip ; inline + +: 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline + +: 4drop ( a b c d -- ) 3drop drop ; inline + +: tuckd ( x y z -- z x y z ) 2 ntuck ; inline + +MACRO: nrev ( n -- quot ) + [ 1+ ] map + reverse + [ [ -nrot ] curry ] map concat ; diff --git a/extra/shuffle/summary.txt b/extra/shuffle/summary.txt new file mode 100644 index 0000000000..12c22b8ae0 --- /dev/null +++ b/extra/shuffle/summary.txt @@ -0,0 +1 @@ +Additional shuffle words diff --git a/extra/shuffle/tags.txt b/extra/shuffle/tags.txt new file mode 100644 index 0000000000..f4274299b1 --- /dev/null +++ b/extra/shuffle/tags.txt @@ -0,0 +1 @@ +extensions From 475ffb17ac9ea096d96cd21dcbb72fa86fe6e2a7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 12:35:42 -0500 Subject: [PATCH 05/13] Update --- extra/shuffle/shuffle.factor | 22 +--------------------- 1 file changed, 1 insertion(+), 21 deletions(-) diff --git a/extra/shuffle/shuffle.factor b/extra/shuffle/shuffle.factor index 2366d15cff..9a0dfe0e88 100644 --- a/extra/shuffle/shuffle.factor +++ b/extra/shuffle/shuffle.factor @@ -1,24 +1,9 @@ ! Copyright (C) 2007 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences namespaces math inference.transforms - combinators macros quotations math.ranges fry ; +USING: kernel generalizations ; IN: shuffle -MACRO: npick ( n -- ) 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ; - -MACRO: ndup ( n -- ) dup [ npick ] curry n*quot ; - -MACRO: nrot ( n -- ) 1- dup saver swap [ r> swap ] n*quot append ; - -MACRO: -nrot ( n -- ) 1- dup [ swap >r ] n*quot swap restorer append ; - -MACRO: ndrop ( n -- ) [ drop ] n*quot ; - -: nnip ( n -- ) swap >r ndrop r> ; inline - -MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ; - : 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline : nipd ( a b c -- b c ) rot drop ; inline @@ -32,8 +17,3 @@ MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ; : 4drop ( a b c d -- ) 3drop drop ; inline : tuckd ( x y z -- z x y z ) 2 ntuck ; inline - -MACRO: nrev ( n -- quot ) - [ 1+ ] map - reverse - [ [ -nrot ] curry ] map concat ; From 838bdb9438d7d417704945f105d9c6186fd47e59 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 12:44:25 -0500 Subject: [PATCH 06/13] ugh --- extra/shuffle/shuffle-docs.factor | 84 ------------------------------ extra/shuffle/shuffle-tests.factor | 23 +------- 2 files changed, 1 insertion(+), 106 deletions(-) delete mode 100755 extra/shuffle/shuffle-docs.factor diff --git a/extra/shuffle/shuffle-docs.factor b/extra/shuffle/shuffle-docs.factor deleted file mode 100755 index 4caace3b00..0000000000 --- a/extra/shuffle/shuffle-docs.factor +++ /dev/null @@ -1,84 +0,0 @@ -! Copyright (C) 2007 Chris Double. -! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup kernel sequences ; -IN: shuffle - -HELP: npick -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link dup } ", " -{ $link over } " and " { $link pick } " that can work " -"for any stack depth. The nth item down the stack will be copied and " -"placed on the top of the stack." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" } -} -{ $see-also dup over pick } ; - -HELP: ndup -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link dup } ", " -{ $link 2dup } " and " { $link 3dup } " that can work " -"for any number of items. The n topmost items on the stack will be copied and " -"placed on the top of the stack." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" } -} -{ $see-also dup 2dup 3dup } ; - -HELP: nnip -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link nip } " and " { $link 2nip } -" that can work " -"for any number of items." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 nnip .s" "4" } -} -{ $see-also nip 2nip } ; - -HELP: ndrop -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link drop } -" that can work " -"for any number of items." -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 ndrop .s" "1" } -} -{ $see-also drop 2drop 3drop } ; - -HELP: nrot -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link rot } " that works for any " -"number of items on the stack. " -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" } -} -{ $see-also rot -nrot } ; - -HELP: -nrot -{ $values { "n" "a number" } } -{ $description "A generalisation of " { $link -rot } " that works for any " -"number of items on the stack. " -} -{ $examples - { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" } -} -{ $see-also rot nrot } ; - -ARTICLE: { "shuffle" "overview" } "Extra shuffle words" -"A number of stack shuffling words for those rare times when you " -"need to deal with tricky stack situations and can't refactor the " -"code to work around it." -{ $subsection ndup } -{ $subsection npick } -{ $subsection nrot } -{ $subsection -nrot } -{ $subsection nnip } -{ $subsection ndrop } ; - -IN: shuffle -ABOUT: { "shuffle" "overview" } \ No newline at end of file diff --git a/extra/shuffle/shuffle-tests.factor b/extra/shuffle/shuffle-tests.factor index 9f2b8e01a9..b5168b903c 100755 --- a/extra/shuffle/shuffle-tests.factor +++ b/extra/shuffle/shuffle-tests.factor @@ -1,25 +1,4 @@ -USING: arrays shuffle kernel math tools.test inference words ; +USING: shuffle tools.test ; [ 8 ] [ 5 6 7 8 3nip ] unit-test -{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test -{ 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test -{ 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test -{ 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test -{ t } [ [ 1 1 ndup ] infer >boolean ] unit-test -{ 1 1 } [ 1 1 ndup ] unit-test -{ 1 2 1 2 } [ 1 2 2 ndup ] unit-test -{ 1 2 3 1 2 3 } [ 1 2 3 3 ndup ] unit-test -{ 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4 ndup ] unit-test -{ t } [ [ 1 2 2 nrot ] infer >boolean ] unit-test -{ 2 1 } [ 1 2 2 nrot ] unit-test -{ 2 3 1 } [ 1 2 3 3 nrot ] unit-test -{ 2 3 4 1 } [ 1 2 3 4 4 nrot ] unit-test -{ t } [ [ 1 2 2 -nrot ] infer >boolean ] unit-test -{ 2 1 } [ 1 2 2 -nrot ] unit-test -{ 3 1 2 } [ 1 2 3 3 -nrot ] unit-test -{ 4 1 2 3 } [ 1 2 3 4 4 -nrot ] unit-test -{ t } [ [ 1 2 3 4 3 nnip ] infer >boolean ] unit-test -{ 4 } [ 1 2 3 4 3 nnip ] unit-test -{ t } [ [ 1 2 3 4 4 ndrop ] infer >boolean ] unit-test -{ 0 } [ 0 1 2 3 4 4 ndrop ] unit-test [ 3 1 2 3 ] [ 1 2 3 tuckd ] unit-test From 776b245c39d5166224578c2f45fbd7411c094dba Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 13:22:57 -0500 Subject: [PATCH 07/13] Cleaning up some usages of -roll --- core/alien/c-types/c-types.factor | 4 ++-- core/kernel/kernel.factor | 3 +-- extra/unix/process/process.factor | 3 ++- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 92f5211b35..d6d0afcf76 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -199,8 +199,8 @@ M: long-long-type box-return ( type -- ) zero? not ; : >c-array ( seq type word -- ) - >r >r dup length dup r> dup -roll r> - [ execute ] 2curry 2each ; inline + [ [ dup length ] dip ] dip + [ [ execute ] 2curry each-index ] 2keep drop ; inline : >c-array-quot ( type vocab -- quot ) dupd set-nth-word [ >c-array ] 2curry ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 023ded5e9c..6b785a61ba 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -64,8 +64,7 @@ DEFER: if : 2keep ( x y quot -- x y ) 2over 2slip ; inline -: 3keep ( x y z quot -- x y z ) - >r 3dup r> -roll 3slip ; inline +: 3keep ( x y z quot -- x y z ) >r 3dup r> -roll 3slip ; inline ! Cleavers : bi ( x p q -- ) diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index 644276ef7d..7d3d757705 100755 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -37,7 +37,8 @@ FUNCTION: int execve ( char* path, char** argv, char** envp ) ; >r [ first ] [ ] bi r> exec-with-env ; : with-fork ( child parent -- ) - fork-process dup zero? -roll swap curry if ; inline + [ [ fork-process dup zero? ] dip [ drop ] prepose ] dip + if ; inline : SIGKILL 9 ; inline : SIGTERM 15 ; inline From 1c7d18bcc95e4d0518272976d339cbc0e5b264cb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 13:33:08 -0500 Subject: [PATCH 08/13] Get rid of a -roll usage --- extra/calendar/calendar.factor | 42 +++++++++-------------------- extra/calendar/format/format.factor | 6 ++--- 2 files changed, 16 insertions(+), 32 deletions(-) diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 6b1f02187d..e7b0b6f43a 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -303,41 +303,25 @@ GENERIC: days-in-year ( obj -- n ) M: integer days-in-year ( year -- n ) leap-year? 366 365 ? ; M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ; -GENERIC: days-in-month ( obj -- n ) +: (days-in-month) ( year month -- n ) + dup 2 = [ drop leap-year? 29 28 ? ] [ nip day-counts nth ] if ; -M: array days-in-month ( obj -- n ) - first2 dup 2 = [ - drop leap-year? 29 28 ? - ] [ - nip day-counts nth - ] if ; +: days-in-month ( timestamp -- n ) + >date< drop (days-in-month) ; -M: timestamp days-in-month ( timestamp -- n ) - >date< drop 2array days-in-month ; - -GENERIC: day-of-week ( obj -- n ) - -M: timestamp day-of-week ( timestamp -- n ) +: day-of-week ( timestamp -- n ) >date< zeller-congruence ; -M: array day-of-week ( array -- n ) - first3 zeller-congruence ; - -GENERIC: day-of-year ( obj -- n ) - -M: array day-of-year ( array -- n ) - first3 - 3dup day-counts rot head-slice sum + - swap leap-year? [ - -roll - pick 3 1 >r r> +:: (day-of-year) ( year month day -- n ) + day-counts month head-slice sum day + + year leap-year? [ + year month day + year 3 1 after=? [ 1+ ] when - ] [ - >r 3drop r> - ] if ; + ] when ; -M: timestamp day-of-year ( timestamp -- n ) - >date< 3array day-of-year ; +: day-of-year ( timestamp -- n ) + >date< (day-of-year) ; : day-offset ( timestamp m -- timestamp n ) over day-of-week - ; inline diff --git a/extra/calendar/format/format.factor b/extra/calendar/format/format.factor index 15dee79006..e2b6a280ef 100755 --- a/extra/calendar/format/format.factor +++ b/extra/calendar/format/format.factor @@ -57,9 +57,9 @@ GENERIC: month. ( obj -- ) M: array month. ( pair -- ) first2 - [ month-names nth write bl number>string print ] 2keep - [ 1 zeller-congruence ] 2keep - 2array days-in-month day-abbreviations2 " " join print + [ month-names nth write bl number>string print ] + [ 1 zeller-congruence ] + [ (days-in-month) day-abbreviations2 " " join print ] 2tri over " " concat write [ [ 1+ day. ] keep From a950924a18d99926d2a0a9c51bcc25d6b0356f52 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 14:20:43 -0500 Subject: [PATCH 09/13] Fixes --- extra/combinators/lib/lib-tests.factor | 2 -- extra/generalizations/generalizations-docs.factor | 10 +++++----- extra/generalizations/generalizations-tests.factor | 4 +++- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index 89d3ed7f7d..d61674280a 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -5,8 +5,6 @@ IN: combinators.lib.tests [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test [ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test -[ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test - [ { "foo" "xbarx" } ] [ { "oof" "bar" } { [ reverse ] [ "x" swap "x" 3append ] } parallel-call diff --git a/extra/generalizations/generalizations-docs.factor b/extra/generalizations/generalizations-docs.factor index decabdc89d..d2af13a9c3 100755 --- a/extra/generalizations/generalizations-docs.factor +++ b/extra/generalizations/generalizations-docs.factor @@ -75,7 +75,7 @@ HELP: nrev { $description "A generalization of " { $link spin } " that reverses any number of items at the top of the stack." } { $examples - { $example "USING: prettyprint generalizations ;" "1 2 3 4 nrev .s" "4\n3\n2\n1\n" } + { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrev .s" "4\n3\n2\n1" } } { $see-also rot nrot } ; @@ -87,8 +87,8 @@ HELP: ndip "stack. The quotation can consume and produce any number of items." } { $examples - { $example "USING: combinators.lib kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" } - { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" } + { $example "USING: generalizations kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" } + { $example "USING: generalizations kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" } } { $see-also dip 2dip } ; @@ -99,7 +99,7 @@ HELP: nslip "removed from the stack, the quotation called, and the items restored." } { $examples - { $example "USING: combinators.lib prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" } + { $example "USING: generalizations prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" } } { $see-also slip nkeep } ; @@ -110,7 +110,7 @@ HELP: nkeep "saved, the quotation called, and the items restored." } { $examples - { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" } + { $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" } } { $see-also keep nslip } ; diff --git a/extra/generalizations/generalizations-tests.factor b/extra/generalizations/generalizations-tests.factor index 1210143094..af010e2026 100755 --- a/extra/generalizations/generalizations-tests.factor +++ b/extra/generalizations/generalizations-tests.factor @@ -1,4 +1,4 @@ -USING: tools.test generalizations kernel math arrays ; +USING: tools.test generalizations kernel math arrays sequences ; IN: generalizations.tests { 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test @@ -30,3 +30,5 @@ IN: generalizations.tests [ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test [ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test [ [ dup 2^ 2array ] 5 napply ] must-infer + +[ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test From ed788fa49ca668f39f9112527f371e4d99d29ff8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 14:23:27 -0500 Subject: [PATCH 10/13] Fix stack effect --- core/alien/c-types/c-types.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index d6d0afcf76..602b22881f 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -198,7 +198,7 @@ M: long-long-type box-return ( type -- ) : c-bool> ( int -- ? ) zero? not ; -: >c-array ( seq type word -- ) +: >c-array ( seq type word -- byte-array ) [ [ dup length ] dip ] dip [ [ execute ] 2curry each-index ] 2keep drop ; inline From cb4ce6c4dfca9f6f6a26198a11353895f15f443b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 14:26:37 -0500 Subject: [PATCH 11/13] Fix naming --- extra/webapps/planet/admin.xml | 8 +++--- extra/webapps/planet/edit-blog.xml | 4 +-- extra/webapps/planet/new-blog.xml | 2 +- extra/webapps/planet/planet-common.xml | 6 ++-- extra/webapps/planet/planet.factor | 40 +++++++++++++------------- extra/webapps/planet/planet.xml | 2 +- 6 files changed, 31 insertions(+), 31 deletions(-) diff --git a/extra/webapps/planet/admin.xml b/extra/webapps/planet/admin.xml index 192592489e..531332eada 100644 --- a/extra/webapps/planet/admin.xml +++ b/extra/webapps/planet/admin.xml @@ -2,12 +2,12 @@ - Planet Factor Administration + Concatenative Planet: Administration
  • - +
    • @@ -15,8 +15,8 @@
- Add Blog - | Update + Add Blog + | Update
diff --git a/extra/webapps/planet/edit-blog.xml b/extra/webapps/planet/edit-blog.xml index fd9c659f59..d1c7013c68 100644 --- a/extra/webapps/planet/edit-blog.xml +++ b/extra/webapps/planet/edit-blog.xml @@ -4,7 +4,7 @@ Edit Blog - + @@ -29,6 +29,6 @@ - Delete + Delete diff --git a/extra/webapps/planet/new-blog.xml b/extra/webapps/planet/new-blog.xml index 4a9638da03..6f75addda5 100644 --- a/extra/webapps/planet/new-blog.xml +++ b/extra/webapps/planet/new-blog.xml @@ -4,7 +4,7 @@ Edit Blog - +
diff --git a/extra/webapps/planet/planet-common.xml b/extra/webapps/planet/planet-common.xml index 6c0affd17f..f4e390056a 100644 --- a/extra/webapps/planet/planet-common.xml +++ b/extra/webapps/planet/planet-common.xml @@ -5,9 +5,9 @@
- Front Page - | Atom Feed - | Admin + Front Page + | Atom Feed + | Admin diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index ca74b7e642..10e706598e 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -17,13 +17,13 @@ furnace.auth furnace.syndication ; IN: webapps.planet -TUPLE: planet-factor < dispatcher ; +TUPLE: planet < dispatcher ; -SYMBOL: can-administer-planet-factor? +SYMBOL: can-administer-planet? -can-administer-planet-factor? define-capability +can-administer-planet? define-capability -TUPLE: planet-factor-admin < dispatcher ; +TUPLE: planet-admin < dispatcher ; TUPLE: blog id name www-url feed-url ; @@ -65,7 +65,7 @@ posting "POSTINGS" : ( -- action ) [ blogroll "blogroll" set-value ] >>init - { planet-factor "admin" } >>template ; + { planet "admin" } >>template ; : ( -- action ) @@ -74,12 +74,12 @@ posting "POSTINGS" postings "postings" set-value ] >>init - { planet-factor "planet" } >>template ; + { planet "planet" } >>template ; : ( -- action ) [ "Planet Factor" ] >>title - [ URL" $planet-factor" ] >>url + [ URL" $planet" ] >>url [ postings ] >>entries ; :: ( entry name -- entry' ) @@ -111,7 +111,7 @@ posting "POSTINGS" [ update-cached-postings - URL" $planet-factor/admin" + URL" $planet/admin" ] >>submit ; : ( -- action ) @@ -120,7 +120,7 @@ posting "POSTINGS" [ "id" value delete-tuples - URL" $planet-factor/admin" + URL" $planet/admin" ] >>submit ; : validate-blog ( -- ) @@ -136,7 +136,7 @@ posting "POSTINGS" : ( -- action ) - { planet-factor "new-blog" } >>template + { planet "new-blog" } >>template [ validate-blog ] >>validate @@ -146,7 +146,7 @@ posting "POSTINGS" [ insert-tuple ] [ - "$planet-factor/admin/edit-blog" >>path + "$planet/admin/edit-blog" >>path swap id>> "id" set-query-param ] @@ -161,7 +161,7 @@ posting "POSTINGS" "id" value select-tuple from-object ] >>init - { planet-factor "edit-blog" } >>template + { planet "edit-blog" } >>template [ validate-integer-id @@ -174,15 +174,15 @@ posting "POSTINGS" [ update-tuple ] [ - "$planet-factor/admin" >>path + "$planet/admin" >>path swap id>> "id" set-query-param ] tri ] >>submit ; -: ( -- responder ) - planet-factor-admin new-dispatcher +: ( -- responder ) + planet-admin new-dispatcher "blogroll" add-main-responder "update" add-responder "new-blog" add-responder @@ -190,15 +190,15 @@ posting "POSTINGS" "delete-blog" add-responder "administer Planet Factor" >>description - { can-administer-planet-factor? } >>capabilities ; + { can-administer-planet? } >>capabilities ; -: ( -- responder ) - planet-factor new-dispatcher +: ( -- responder ) + planet new-dispatcher "list" add-main-responder "feed.xml" add-responder - "admin" add-responder + "admin" add-responder - { planet-factor "planet-common" } >>template ; + { planet "planet-common" } >>template ; : start-update-task ( db params -- ) '[ , , [ update-cached-postings ] with-db ] 10 minutes every drop ; diff --git a/extra/webapps/planet/planet.xml b/extra/webapps/planet/planet.xml index fe4d23bd3b..340e6c4bee 100644 --- a/extra/webapps/planet/planet.xml +++ b/extra/webapps/planet/planet.xml @@ -2,7 +2,7 @@ - Planet Factor + Concatenative Planet
From 3929c1239228e34425301acc8be03bfd2e173f1f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 15:22:03 -0500 Subject: [PATCH 12/13] Add failing unit test for string encoding --- extra/db/tuples/tuples-tests.factor | 31 ++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 36e84187eb..2edf7552cb 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -4,7 +4,7 @@ USING: io.files kernel tools.test db db.tuples classes db.types continuations namespaces math math.ranges prettyprint calendar sequences db.sqlite math.intervals db.postgresql accessors random math.bitfields.lib -math.ranges strings sequences.lib urls ; +math.ranges strings sequences.lib urls fry ; IN: db.tuples.tests TUPLE: person the-id the-name the-number the-real @@ -201,10 +201,10 @@ TUPLE: annotation n paste-id summary author mode contents ; ! ] with-db : test-sqlite ( quot -- ) - >r "tuples-test.db" temp-file sqlite-db r> with-db ; + [ ] swap '[ "tuples-test.db" temp-file sqlite-db , with-db ] unit-test ; : test-postgresql ( quot -- ) - >r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ; + [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db , with-db ] unit-test ; : test-repeated-insert [ ] [ person ensure-table ] unit-test @@ -463,6 +463,31 @@ fubbclass "FUBCLASS" { } define-persistent [ t ] [ fubbclass new select-tuples [ fubbclass? ] all? ] unit-test ; [ test-db-inheritance ] test-sqlite +[ test-db-inheritance ] test-postgresql + + +TUPLE: string-encoding-test id string ; + +string-encoding-test "STRING_ENCODING_TEST" { + { "id" "ID" +db-assigned-id+ } + { "string" "STRING" TEXT } +} define-persistent + +: test-string-encoding ( -- ) + [ ] [ string-encoding-test ensure-table ] unit-test + + [ ] [ + string-encoding-test new + "\u{copyright-sign}\u{bengali-letter-cha}" >>string + [ insert-tuple ] [ id>> "id" set ] bi + ] unit-test + + [ "\u{copyright-sign}\u{bengali-letter-cha}" ] [ + string-encoding-test new "id" get >>id select-tuple string>> + ] unit-test ; + +[ test-string-encoding ] test-sqlite +[ test-string-encoding ] test-postgresql ! Don't comment these out. These words must infer \ bind-tuple must-infer From 7248af54cc88cfd7b2a35cf9a1a203fe9adf6d3d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 8 Jul 2008 15:22:44 -0500 Subject: [PATCH 13/13] Update for planet rename --- extra/websites/concatenative/concatenative.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 6d65f10783..211dcb3c11 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -48,7 +48,7 @@ TUPLE: factor-website < dispatcher ; "blogs" add-responder "todo" add-responder "pastebin" add-responder - "planet" add-responder + "planet" add-responder "wiki" add-responder "wee-url" add-responder "user-admin" add-responder