diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 92f5211b35..602b22881f 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -198,9 +198,9 @@ M: long-long-type box-return ( type -- ) : c-bool> ( int -- ? ) zero? not ; -: >c-array ( seq type word -- ) - >r >r dup length dup r> dup -roll r> - [ execute ] 2curry 2each ; inline +: >c-array ( seq type word -- byte-array ) + [ [ 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/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/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/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/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 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..d61674280a 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -5,16 +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" } ] [ { "oof" "bar" } { [ reverse ] [ "x" swap "x" 3append ] } parallel-call 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/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 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..d2af13a9c3 --- /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 4 nrev .s" "4\n3\n2\n1" } +} +{ $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: 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 } ; + +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: generalizations 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: 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 } ; + +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..af010e2026 --- /dev/null +++ b/extra/generalizations/generalizations-tests.factor @@ -0,0 +1,34 @@ +USING: tools.test generalizations kernel math arrays sequences ; +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 + +[ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test 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/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 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 5591844fde..90bca7cef9 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/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 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 ; 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/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 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/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
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 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..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 -sequences.lib 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 ; 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