diff --git a/Makefile b/Makefile index 5f7cdca06d..769aeacb8c 100755 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ AR = ar LD = ld EXECUTABLE = factor -VERSION = 0.91 +VERSION = 0.92 IMAGE = factor.image BUNDLE = Factor.app 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/image/image.factor b/core/bootstrap/image/image.factor index a8fcc712eb..5812a0f8e7 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -505,6 +505,8 @@ M: quotation ' jit-r>-word jit-swap jit-swap-word + jit-over + jit-over-word jit-fixnum-fast jit-fixnum-fast-word jit-fixnum>= 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/alarms/alarms-docs.factor b/extra/alarms/alarms-docs.factor index b25df236c9..f07a8b9a2d 100755 --- a/extra/alarms/alarms-docs.factor +++ b/extra/alarms/alarms-docs.factor @@ -10,7 +10,7 @@ HELP: add-alarm HELP: later { $values { "quot" quotation } { "dt" duration } { "alarm" alarm } } -{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } { $link from-now } "." } ; +{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ; HELP: cancel-alarm { $values { "alarm" alarm } } diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor index ddc1d34121..a72960f20f 100755 --- a/extra/alarms/alarms.factor +++ b/extra/alarms/alarms.factor @@ -82,10 +82,10 @@ PRIVATE> [ register-alarm ] keep ; : later ( quot dt -- alarm ) - from-now f add-alarm ; + hence f add-alarm ; : every ( quot dt -- alarm ) - [ from-now ] keep add-alarm ; + [ hence ] keep add-alarm ; : cancel-alarm ( alarm -- ) alarm-entry [ alarms get-global heap-delete ] if-box? ; 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 index bcb7c2238f..0834c84c9a 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -1,7 +1,7 @@ USING: kernel parser namespaces sequences quotations arrays vectors splitting - strings words math - macros arrays.lib combinators.lib combinators.conditional newfx ; + strings words math generalizations + macros 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..0abc00b4a4 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -284,7 +284,7 @@ MEMO: unix-1970 ( -- timestamp ) : now ( -- timestamp ) gmt >local-time ; -: from-now ( dt -- timestamp ) now swap time+ ; +: hence ( dt -- timestamp ) now swap time+ ; : ago ( dt -- timestamp ) now swap time- ; : day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline @@ -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 @@ -373,7 +357,7 @@ M: timestamp day-of-year ( timestamp -- n ) M: timestamp sleep-until timestamp>millis sleep-until ; -M: duration sleep from-now sleep-until ; +M: duration sleep hence sleep-until ; { { [ os unix? ] [ "calendar.unix" ] } 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/columns/columns-docs.factor b/extra/columns/columns-docs.factor index a2f0cccf3b..a5b26e3fd0 100644 --- a/extra/columns/columns-docs.factor +++ b/extra/columns/columns-docs.factor @@ -11,7 +11,7 @@ HELP: column HELP: ( seq n -- column ) { $values { "seq" sequence } { "n" "a non-negative integer" } { "column" column } } -{ $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of" { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." } +{ $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of " { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." } { $examples { $example "USING: arrays prettyprint columns ;" 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/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor index f2dbd8bc2b..22d811ad3f 100644 --- a/extra/ctags/ctags-docs.factor +++ b/extra/ctags/ctags-docs.factor @@ -5,25 +5,26 @@ ARTICLE: "ctags" "Ctags file" { $emphasis "ctags" } " generates a index file of every factor word in ctags format as supported by vi and other editors. More information can be found at " { $url "http://en.wikipedia.org/wiki/Ctags" } "." { $subsection ctags } { $subsection ctags-write } +{ $subsection ctag-strings } { $subsection ctag } ; HELP: ctags ( path -- ) { $values { "path" "a pathname string" } } { $description "Generates a index file in ctags format and stores in " { $snippet "path" } "." } { $examples - { $example + { $unchecked-example "USING: ctags ;" - "\"tags\" ctags-write" + "\"tags\" ctags" "" } } ; HELP: ctags-write ( seq path -- ) -{ $values { "seq" sequence } +{ $values { "alist" "an association list" } { "path" "a pathname string" } } -{ $description "Stores a " { $snippet "seq" } " in " { $snippet "path" } ". " { $snippet "seq" } " must be an association list with ctags format: key must be a valid word and value a sequence whose first element is a resource name and second element is a line number" } +{ $description "Stores a " { $snippet "alist" } " in " { $snippet "path" } ". " { $snippet "alist" } " must be an association list with ctags format: key must be a valid word and value a sequence whose first element is a resource name and second element is a line number" } { $examples - { $example + { $unchecked-example "USING: kernel ctags ;" "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } \"tags\" ctags-write" "" @@ -32,13 +33,25 @@ HELP: ctags-write ( seq path -- ) { $notes { $snippet "tags" } " file will contain a single line: if\\t/path/to/factor/extra/unix/unix.factor\\t91" } ; +HELP: ctag-strings ( alist -- seq ) +{ $values { "alist" "an association list" } + { "seq" sequence } } +{ $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." } +{ $examples + { $unchecked-example + "USING: kernel ctags prettyprint ;" + "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings ." + "{ \"if\\t/path/to/factor/extra/unix/unix.factor\\t91\" }" + } +} ; + HELP: ctag ( seq -- str ) { $values { "seq" sequence } { "str" string } } { $description "Outputs a string " { $snippet "str" } " in ctag format for sequence with two elements, first one must be a valid word and second one a sequence whose first element is a resource name and second element is a line number" } { $examples - { $example - "USING: kernel ctags ;" + { $unchecked-example + "USING: kernel ctags prettyprint ;" "{ if { \"resource:extra/unix/unix.factor\" 91 } } ctag ." "\"if\\t/path/to/factor/extra/unix/unix.factor\\t91\"" } diff --git a/extra/ctags/ctags-tests.factor b/extra/ctags/ctags-tests.factor index dc6e402653..6c73b58ecb 100644 --- a/extra/ctags/ctags-tests.factor +++ b/extra/ctags/ctags-tests.factor @@ -1,7 +1,12 @@ -USING: kernel ctags tools.test io.backend sequences ; -IN: columns.tests +USING: kernel ctags tools.test io.backend sequences arrays prettyprint ; +IN: ctags.tests [ t ] [ "if\t" "resource:extra/unix/unix.factor" normalize-path "\t91" 3append { if { "resource:extra/unix/unix.factor" 91 } } ctag = +] unit-test + +[ t ] [ + "if\t" "resource:extra/unix/unix.factor" normalize-path "\t91" 3append 1array + { { if { "resource:extra/unix/unix.factor" 91 } } } ctag-strings = ] unit-test \ No newline at end of file diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor index 5b9ff90e5c..23d9aeb90c 100644 --- a/extra/ctags/ctags.factor +++ b/extra/ctags/ctags.factor @@ -18,8 +18,11 @@ IN: ctags second number>string % ] "" make ; +: ctag-strings ( seq1 -- seq2 ) + { } swap [ ctag suffix ] each ; + : ctags-write ( seq path -- ) - ascii [ [ ctag print ] each ] with-file-writer ; + [ ctag-strings ] dip ascii set-file-lines ; : (ctags) ( -- seq ) { } all-words [ diff --git a/extra/db/pools/pools-tests.factor b/extra/db/pools/pools-tests.factor index f0534a1d34..34e072c3a5 100644 --- a/extra/db/pools/pools-tests.factor +++ b/extra/db/pools/pools-tests.factor @@ -1,8 +1,22 @@ IN: db.pools.tests -USING: db.pools tools.test ; +USING: db.pools tools.test continuations io.files namespaces +accessors kernel math destructors ; \ must-infer { 2 0 } [ [ ] with-db-pool ] must-infer-as { 1 0 } [ [ ] with-pooled-db ] must-infer-as + +! Test behavior after image save/load +USE: db.sqlite + +[ "pool-test.db" temp-file delete-file ] ignore-errors + +[ ] [ "pool-test.db" sqlite-db "pool" set ] unit-test + +[ ] [ "pool" get expired>> t >>expired drop ] unit-test + +[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test + +[ ] [ "pool" get dispose ] unit-test 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/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor index 68161382c1..ce533bce64 100755 --- a/extra/furnace/auth/login/login.factor +++ b/extra/furnace/auth/login/login.factor @@ -40,10 +40,9 @@ M: login-realm modify-form ( responder -- ) permit-id get realm get name>> permit-id-key "$login-realm" resolve-base-path >>path realm get - [ timeout>> from-now >>expires ] [ domain>> >>domain ] [ secure>> >>secure ] - tri ; + bi ; : put-permit-cookie ( response -- response' ) put-cookie ; diff --git a/extra/furnace/cache/cache.factor b/extra/furnace/cache/cache.factor index a614a52548..68786a55ab 100644 --- a/extra/furnace/cache/cache.factor +++ b/extra/furnace/cache/cache.factor @@ -31,6 +31,6 @@ TUPLE: server-state-manager < filter-responder timeout ; new swap >>responder 20 minutes >>timeout ; inline - + : touch-state ( state manager -- ) - timeout>> from-now >>expires drop ; + timeout>> hence >>expires drop ; diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor index 0ec9648a67..5590a9e55e 100755 --- a/extra/furnace/sessions/sessions.factor +++ b/extra/furnace/sessions/sessions.factor @@ -116,7 +116,6 @@ M: session-saver dispose : ( -- cookie ) session get id>> session-id-key "$sessions" resolve-base-path >>path - sessions get timeout>> from-now >>expires sessions get domain>> >>domain ; : put-session-cookie ( response -- response' ) 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/pools/pools.factor b/extra/io/pools/pools.factor index 0e37e41a76..aa734e6809 100644 --- a/extra/io/pools/pools.factor +++ b/extra/io/pools/pools.factor @@ -9,7 +9,7 @@ TUPLE: pool connections disposed expired ; : check-pool ( pool -- ) dup check-disposed dup expired>> expired? [ - ALIEN: 31337 >>expired + 31337 >>expired connections>> delete-all ] [ drop ] if ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 165747084e..b984b1f156 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -125,7 +125,8 @@ M: fd refill } cond ; M: unix (wait-to-read) ( port -- ) - dup dup handle>> refill dup + dup + dup handle>> dup check-disposed refill dup [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ; ! Writers @@ -144,7 +145,9 @@ M: fd drain } cond ; M: unix (wait-to-write) ( port -- ) - dup dup handle>> drain dup [ wait-for-port ] [ 2drop ] if ; + dup + dup handle>> dup check-disposed drain + dup [ wait-for-port ] [ 2drop ] if ; M: unix io-multiplex ( ms/f -- ) mx get-global wait-for-events ; diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 419509f124..e25be71872 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -61,6 +61,7 @@ C: FileArgs : make-FileArgs ( port -- ) { + [ handle>> check-disposed ] [ handle>> handle>> ] [ buffer>> ] [ buffer>> buffer-length ] diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 786275c736..e9df2ddab9 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -74,7 +74,7 @@ M: winnt add-completion ( win32-handle -- ) ] if ; M: win32-handle cancel-operation - handle>> CancelIo drop ; + [ check-disposed ] [ handle>> CancelIo drop ] bi ; M: winnt io-multiplex ( ms -- ) handle-overlapped [ 0 io-multiplex ] when ; 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 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/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/tetris/tetris.factor b/extra/tetris/tetris.factor index 02f8f240d2..c2f874598c 100644 --- a/extra/tetris/tetris.factor +++ b/extra/tetris/tetris.factor @@ -45,7 +45,7 @@ tetris-gadget H{ dup tetris-gadget-tetris maybe-update relayout-1 ; M: tetris-gadget graft* ( gadget -- ) - dup [ tick ] curry 100 milliseconds from-now 100 milliseconds add-alarm + dup [ tick ] curry 100 milliseconds every swap set-tetris-gadget-alarm ; M: tetris-gadget ungraft* ( gadget -- ) 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/tools/walker/walker-tests.factor b/extra/tools/walker/walker-tests.factor index 7f154a4dbf..e002af8f6d 100755 --- a/extra/tools/walker/walker-tests.factor +++ b/extra/tools/walker/walker-tests.factor @@ -1,7 +1,7 @@ USING: tools.walker io io.streams.string kernel math math.private namespaces prettyprint sequences tools.test continuations math.parser threads arrays tools.walker.debug -generic.standard ; +generic.standard sequences.private kernel.private ; IN: tools.walker.tests [ { } ] [ @@ -50,6 +50,10 @@ IN: tools.walker.tests [ 5 6 number= ] test-walker ] unit-test +[ { 0 } ] [ + [ 0 { array-capacity } declare ] test-walker +] unit-test + [ { f } ] [ [ "XYZ" "XYZ" mismatch ] test-walker ] unit-test diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor index 88bc2bcee7..5c00fbfdb0 100755 --- a/extra/ui/gestures/gestures.factor +++ b/extra/ui/gestures/gestures.factor @@ -121,7 +121,7 @@ SYMBOL: drag-timer : start-drag-timer ( -- ) hand-buttons get-global empty? [ [ drag-gesture ] - 300 milliseconds from-now + 300 milliseconds hence 100 milliseconds add-alarm drag-timer get-global >box ] when ; 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/mini-planet.xml b/extra/webapps/planet/mini-planet.xml deleted file mode 100644 index 661c2dc0f7..0000000000 --- a/extra/webapps/planet/mini-planet.xml +++ /dev/null @@ -1,14 +0,0 @@ - - - - - - -

-
- Read More... -

- - - - 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/webapps/wiki/initial-content/Farkup.txt b/extra/webapps/wiki/initial-content/Farkup.txt new file mode 100644 index 0000000000..8814af6c0a --- /dev/null +++ b/extra/webapps/wiki/initial-content/Farkup.txt @@ -0,0 +1,63 @@ +Look at the source to this page by clicking *Edit* to compare the farkup language with resulting output. + += level 1 heading = + +== level 2 heading == + +=== level 3 heading === + +==== level 4 heading ==== + +Here is a paragraph of text, with _emphasized_ and *strong* text, together with an inline %code snippet%. Did you know that E=mc^2^, and L~2~ spaces are cool? Of course, if you want to include \_ special \* characters \^ you \~ can \% do that, too. + +You can make [[Wiki Links]] just like that, as well as links to external sites: [[http://sbcl.sourceforge.net]]. [[Factor|Custom link text]] can be used [[http://www.apple.com|with both types of links]]. + +Images can be embedded in the text: + +[[image:http://factorcode.org/graphics/logo.png]] + +- a list +- with three +- items + +|a table|with|four|columns| +|and|two|rows|...| + +Here is some code: + +[{HAI +CAN HAS STDIO? +VISIBLE "HAI WORLD!" +KTHXBYE}] + +There is syntax highlighting various languages, too: + +[factor{PEG: parse-request-line ( string -- triple ) + #! Triple is { method url version } + [ + 'space' , + 'http-method' , + 'space' , + 'url' , + 'space' , + 'http-version' , + 'space' , + ] seq* just ;}] + +Some Java: + +[java{/** + * Returns the extension of the specified filename, or an empty + * string if there is none. + * @param path The path + */ +public static String getFileExtension(String path) +{ + int fsIndex = getLastSeparatorIndex(path); + int index = path.lastIndexOf('.'); + // there could be a dot in the path and no file extension + if(index == -1 || index < fsIndex ) + return ""; + else + return path.substring(index); +}}] diff --git a/extra/webapps/wiki/initial-content/Front Page.txt b/extra/webapps/wiki/initial-content/Front Page.txt new file mode 100644 index 0000000000..37351eed38 --- /dev/null +++ b/extra/webapps/wiki/initial-content/Front Page.txt @@ -0,0 +1,5 @@ +Congratulations, you are now running your very own Wiki. + +You can now click *Edit* below and begin editing the content of the [[Front Page]]. This Wiki uses [[Farkup]] to mark up text. + +Two special article names are recognized by the Wiki: [[Sidebar]] and [[Footer]]. They do not exist by default, but if you create them, they will be visible on every page. diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml index 0abd36a7cd..5cddcee628 100644 --- a/extra/webapps/wiki/wiki-common.xml +++ b/extra/webapps/wiki/wiki-common.xml @@ -13,6 +13,7 @@ Front Page | All Articles | Recent Changes + | Random Article @@ -45,6 +46,16 @@ + + + +
+ + + + + +
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index 77ee242668..3c87f3cd49 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel hashtables calendar +USING: accessors kernel hashtables calendar random assocs namespaces splitting sequences sorting math.order present +io.files io.encodings.ascii syndication html.components html.forms http.server @@ -115,6 +116,14 @@ M: revision feed-entry-url id>> revision-url ; { wiki "view" } >>template ; +: ( -- action ) + + [ + article new select-tuples random + [ title>> ] [ "Front Page" ] if* + view-url + ] >>display ; + : amend-article ( revision article -- ) swap id>> >>revision update-tuple ; @@ -286,15 +295,15 @@ M: revision feed-entry-url id>> revision-url ; { wiki "page-common" } >>template ; : init-sidebar ( -- ) - "Sidebar" latest-revision [ - "sidebar" [ from-object ] nest-form - ] when* ; + "Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when* + "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ; : ( -- dispatcher ) wiki new-dispatcher "" add-responder "view" add-responder "revision" add-responder + "random" add-responder "revisions" add-responder "revisions.atom" add-responder "diff" add-responder @@ -309,3 +318,15 @@ M: revision feed-entry-url id>> revision-url ; [ init-sidebar ] >>init { wiki "wiki-common" } >>template ; + +: init-wiki ( -- ) + "resource:extra/webapps/wiki/initial-content" directory* keys + [ + [ ascii file-contents ] [ file-name "." split1 drop ] bi + f + swap >>title + swap >>content + "slava" >>author + now >>date + add-revision + ] each ; diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 6d65f10783..1ae7f63a27 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -25,7 +25,7 @@ webapps.wee-url webapps.user-admin ; IN: websites.concatenative -: test-db ( -- db params ) "resource:test.db" sqlite-db ; +: test-db ( -- params db ) "resource:test.db" sqlite-db ; : init-factor-db ( -- ) test-db [ @@ -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..241eddf9f0 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 @@ -1285,10 +1285,10 @@ FUNCTION: void SetLastErrorEx ( DWORD dwErrCode, DWORD dwType ) ; ! FUNCTION: SetWindowPlacement FUNCTION: BOOL SetWindowPos ( HWND hWnd, HWND hWndInsertAfter, int X, int Y, int cx, int cy, UINT uFlags ) ; -: HWND_BOTTOM ALIEN: 1 ; -: HWND_NOTOPMOST ALIEN: -2 ; -: HWND_TOP ALIEN: 0 ; -: HWND_TOPMOST ALIEN: -1 ; +: HWND_BOTTOM ( -- alien ) 1 ; +: HWND_NOTOPMOST ( -- alien ) -2 ; +: HWND_TOP ( -- alien ) 0 ; +: HWND_TOPMOST ( -- alien ) -1 ; ! FUNCTION: SetWindowRgn ! FUNCTION: SetWindowsHookA diff --git a/vm/quotations.c b/vm/quotations.c index 0f60eea3e1..7eab41688a 100755 --- a/vm/quotations.c +++ b/vm/quotations.c @@ -422,7 +422,10 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset) } if(jit_ignore_declare_p(untag_object(array),i)) { + if(offset == 0) return i; + i++; + break; } default: