diff --git a/Factor.app/Contents/Info.plist b/Factor.app/Contents/Info.plist index 1c07f95643..591886b196 100644 --- a/Factor.app/Contents/Info.plist +++ b/Factor.app/Contents/Info.plist @@ -32,7 +32,7 @@ CFBundlePackageType APPL CFBundleVersion - 0.93 + 0.94 NSHumanReadableCopyright Copyright © 2003-2010 Factor developers NSServices diff --git a/GNUmakefile b/GNUmakefile index 9f93deedf2..30f44e9eba 100755 --- a/GNUmakefile +++ b/GNUmakefile @@ -4,7 +4,7 @@ ifdef CONFIG AR = ar LD = ld - VERSION = 0.93 + VERSION = 0.94 BUNDLE = Factor.app LIBPATH = -L/usr/X11R6/lib diff --git a/basis/binary-search/binary-search-tests.factor b/basis/binary-search/binary-search-tests.factor index a797219a01..00d67dd7e3 100644 --- a/basis/binary-search/binary-search-tests.factor +++ b/basis/binary-search/binary-search-tests.factor @@ -9,7 +9,9 @@ IN: binary-search.tests [ 4 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test [ 10 ] [ 10 20 iota [ <=> ] with search drop ] unit-test -[ t ] [ "hello" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test +[ 0 ] [ "alligator" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test [ 3 ] [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test +[ 5 ] [ "java" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test +[ t ] [ "hello" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test [ f ] [ "hello" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test [ f ] [ "zebra" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test diff --git a/basis/binary-search/binary-search.factor b/basis/binary-search/binary-search.factor index 83bf9f13f4..36e983a1c8 100644 --- a/basis/binary-search/binary-search.factor +++ b/basis/binary-search/binary-search.factor @@ -1,41 +1,29 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences sequences.private accessors math -math.order combinators hints arrays ; +USING: accessors arrays combinators hints kernel locals math +math.order sequences ; IN: binary-search ) -- i elt ) + from to + 2/ :> midpoint@ + midpoint@ seq nth :> midpoint -: decide ( quot seq -- quot seq <=> ) - [ midpoint swap call ] 2keep rot ; inline - -: finish ( quot slice -- i elt ) - [ [ from>> ] [ midpoint@ ] bi + ] [ seq>> ] bi - [ drop ] [ dup ] [ ] tri* nth ; inline - -DEFER: (search) - -: keep-searching ( seq quot -- slice ) - [ dup midpoint@ ] dip call collapse-slice slice boa (search) ; inline - -: (search) ( ... quot: ( ... elt -- ... <=> ) seq -- ... i elt ) - dup length 1 <= [ - finish + to from - 1 <= [ + midpoint@ midpoint ] [ - decide { - { +eq+ [ finish ] } - { +lt+ [ [ (head) ] keep-searching ] } - { +gt+ [ [ (tail) ] keep-searching ] } + midpoint quot call { + { +eq+ [ midpoint@ midpoint ] } + { +lt+ [ seq from midpoint@ quot (search) ] } + { +gt+ [ seq midpoint@ to quot (search) ] } } case ] if ; inline recursive PRIVATE> -: search ( seq quot -- i elt ) - over empty? [ 2drop f f ] [ swap (search) ] if ; +: search ( seq quot: ( elt -- <=> ) -- i elt ) + over empty? [ 2drop f f ] [ [ 0 over length ] dip (search) ] if ; inline : natural-search ( obj seq -- i elt ) diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 2e305b2c39..13917fd6bf 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -193,25 +193,6 @@ M: number detect-number ; ! Regression [ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test -! Regression -USE: sorting -USE: binary-search -USE: binary-search.private - -: old-binsearch ( elt quot: ( ..a -- ..b ) seq -- elt quot i ) - dup length 1 <= [ - from>> - ] [ - [ midpoint swap call ] 3keep [ rot ] dip swap dup zero? - [ drop dup from>> swap midpoint@ + ] - [ drop dup midpoint@ head-slice old-binsearch ] if - ] if ; inline recursive - -[ 10 ] [ - 10 20 iota - [ [ - ] swap old-binsearch ] compile-call 2nip -] unit-test - ! Regression : empty-compound ( -- ) ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index f7f774ad86..e6c656f2da 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -679,16 +679,11 @@ HELP: collapse-slice { $description "Prepares to take the slice of a slice by adjusting the start and end indices accordingly, and replacing the slice with its underlying sequence." } ; -HELP: -{ $values { "seq" sequence } { "slice" slice } } -{ $description "Outputs a slice with the same elements as " { $snippet "seq" } ", and " { $snippet "from" } " equal to 0 and " { $snippet "to" } " equal to the length of " { $snippet "seq" } "." } -{ $notes "Some words create slices then proceed to read the " { $snippet "to" } " and " { $snippet "from" } " slots of the slice. To behave predictably when they are themselves given a slice as input, they apply this word first to get a canonical slice." } ; - HELP: { $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "slice" slice } } { $description "Outputs a new virtual sequence sharing storage with the subrange of elements in " { $snippet "seq" } " with indices starting from and including " { $snippet "m" } ", and up to but not including " { $snippet "n" } "." } { $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." } -{ $notes "Taking the slice of a slice outputs a slice of the underlying sequence of the original slice. Keep this in mind when writing code which depends on the values of " { $snippet "from" } " and " { $snippet "to" } " being equal to the inputs to this word. The " { $link } " word might be helpful in such situations." } ; +{ $notes "Taking the slice of a slice outputs a slice of the underlying sequence, instead of a slice of a slice. This means that you cannot assume that the " { $snippet "from" } " and " { $snippet "to" } " slots of the resulting slice will be equal to the values you passed to " { $link } "." } ; { subseq } related-words @@ -1534,8 +1529,6 @@ $nl { $subsections rest-slice but-last-slice } "Taking a sequence apart into a head and a tail:" { $subsections unclip-slice unclip-last-slice cut-slice } -"A utility for words which use slices as iterators:" -{ $subsections } "Replacing slices with new elements:" { $subsections replace-slice } ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d9c234e717..2155f1439f 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -898,11 +898,6 @@ PRIVATE> : unclip-last-slice ( seq -- butlast-slice last ) [ but-last-slice ] [ last ] bi ; inline -: ( seq -- slice ) - dup slice? [ { } like ] when - [ drop 0 ] [ length ] [ ] tri ; - inline - +{ $values + { "pat" sequence } { "bm" boyer-moore } +} +{ $description + "Given a pattern performs pattern preprocessing and returns " + "results as an (opaque) object that is reusable across " + "searches in different sequences via " { $link search-from } + " generic word." +} ; + +HELP: search-from +{ $values + { "seq" sequence } + { "from" "a non-negative integer" } + { "obj" object } + { "i/f" "the index of first match or " { $link f } } +} +{ $description "Performs an attempt to find the first " + "occurence of pattern in " { $snippet "seq" } + " starting from " { $snippet "from" } " using " + "Boyer-Moore search algorithm. Output is the index " + "if the attempt was succeessful and " { $link f } + " otherwise." +} ; + +HELP: search +{ $values + { "seq" sequence } + { "obj" object } + { "i/f" "the index of first match or " { $link f } } +} +{ $description "A simpler variant of " { $link search-from } + " that starts searching from the beginning of the sequence." +} ; + +ARTICLE: "boyer-moore" "The Boyer-Moore algorithm" +{ $heading "Summary" } +"The " { $vocab-link "boyer-moore" } " vocabulary " +"implements a Boyer-Moore string search algorithm with " +"so-called 'strong good suffix shift rule'. Since algorithm is " +"alphabet-independent it is applicable to searching in any " +"collection that implements " { $links "sequence-protocol" } "." + +{ $heading "Complexity" } +"Let " { $snippet "n" } " and " { $snippet "m" } " be lengths " +"of the sequences being searched " { $emphasis "in" } " and " +{ $emphasis "for" } " respectively. Then searching runs in " +{ $snippet "O(n)" } " time in its worst case using additional " +{ $snippet "O(m)" } " space. The preprocessing phase runs in " +{ $snippet "O(m)" } " time." +; + +ABOUT: "boyer-moore" diff --git a/extra/boyer-moore/boyer-moore-tests.factor b/extra/boyer-moore/boyer-moore-tests.factor new file mode 100644 index 0000000000..e444c35189 --- /dev/null +++ b/extra/boyer-moore/boyer-moore-tests.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test boyer-moore ; +IN: boyer-moore.tests + +[ 0 ] [ "qwerty" "" search ] unit-test +[ 0 ] [ "" "" search ] unit-test +[ f ] [ "qw" "qwerty" search ] unit-test +[ 3 ] [ "qwerty" "r" search ] unit-test +[ 8 ] [ "qwerasdfqwer" 2 "qwe" search-from ] unit-test diff --git a/extra/boyer-moore/boyer-moore.factor b/extra/boyer-moore/boyer-moore.factor new file mode 100644 index 0000000000..aba3f614a1 --- /dev/null +++ b/extra/boyer-moore/boyer-moore.factor @@ -0,0 +1,78 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel locals math math.order +math.ranges sequences sequences.private z-algorithm ; +IN: boyer-moore + + ] [ [1,b) ] bi ] keep pick + [ (normal-suffixes) ] 2curry each ; inline + +:: (partial-suffixes) ( len old elt i -- len old/new old ) + len elt i 1 + = [ len elt - ] [ old ] if old ; inline + +: partial-suffixes ( zs -- ss ) + [ length dup ] [ ] bi + [ (partial-suffixes) ] map-index 2nip ; inline + +: ( seq -- table ) + z-values [ partial-suffixes ] [ normal-suffixes ] bi + [ [ nip ] when* ] 2map reverse! ; inline + +: insert-bc-shift ( table elt len i -- table ) + 1 + swap - swap pick 2dup key? + [ 3drop ] [ set-at ] if ; inline + +: ( seq -- table ) + H{ } clone swap [ length ] keep + [ insert-bc-shift ] with each-index ; inline + +TUPLE: boyer-moore pattern bc-table gs-table ; + +: gs-shift ( i c bm -- s ) nip gs-table>> nth-unsafe ; inline + +: bc-shift ( i c bm -- s ) bc-table>> at dup 1 ? + ; inline + +: do-shift ( pos i c bm -- newpos ) + [ gs-shift ] [ bc-shift ] bi-curry 2bi max + ; inline + +: match? ( i1 s1 i2 s2 -- ? ) [ nth-unsafe ] 2bi@ = ; inline + +:: mismatch? ( s1 s2 pos len -- i/f ) + len 1 - [ [ pos + s1 ] keep s2 match? not ] + find-last-integer ; inline + +:: (search-from) ( seq from bm -- i/f ) + bm pattern>> :> pat + pat length :> plen + seq length plen - :> lim + from + [ + dup lim <= + [ + seq pat pick plen mismatch? + [ 2dup + seq nth-unsafe bm do-shift t ] [ f ] if* + ] [ drop f f ] if + ] loop ; inline + +PRIVATE> + +: ( pat -- bm ) + dup [ ] [ ] bi + boyer-moore boa ; + +GENERIC: search-from ( seq from obj -- i/f ) + +M: sequence search-from + dup length zero? + [ 3drop 0 ] [ (search-from) ] if ; + +M: boyer-moore search-from (search-from) ; + +: search ( seq obj -- i/f ) [ 0 ] dip search-from ; diff --git a/extra/boyer-moore/summary.txt b/extra/boyer-moore/summary.txt new file mode 100644 index 0000000000..298fcc354b --- /dev/null +++ b/extra/boyer-moore/summary.txt @@ -0,0 +1 @@ +Boyer-Moore string search algorithm diff --git a/extra/boyer-moore/tags.txt b/extra/boyer-moore/tags.txt new file mode 100644 index 0000000000..49b4f2328e --- /dev/null +++ b/extra/boyer-moore/tags.txt @@ -0,0 +1 @@ +algorithms diff --git a/extra/mason/config/config.factor b/extra/mason/config/config.factor index 5ec44df0a9..48f4d307c8 100644 --- a/extra/mason/config/config.factor +++ b/extra/mason/config/config.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: system io.files io.pathnames namespaces kernel accessors assocs ; @@ -39,11 +39,11 @@ target-os get-global [ ! Keep test-log around? SYMBOL: builder-debug -! Host to send status notifications to. -SYMBOL: status-host +! URL for status notifications. +SYMBOL: status-url -! Username to log in. -SYMBOL: status-username +! Password for status notifications. +SYMBOL: status-secret SYMBOL: upload-help? diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor index d7319c0f20..144f0de122 100644 --- a/extra/mason/notify/notify.factor +++ b/extra/mason/notify/notify.factor @@ -1,57 +1,50 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays accessors io io.sockets io.encodings.utf8 io.files -io.launcher kernel make mason.config mason.common mason.email -mason.twitter namespaces sequences prettyprint fry ; +USING: accessors fry http.client io io.encodings.utf8 io.files +kernel mason.common mason.config mason.email mason.twitter +namespaces prettyprint sequences ; IN: mason.notify -: status-notify ( input-file args -- ) - status-host get [ - [ - "ssh" , status-host get , "-l" , status-username get , - "./mason-notify" , - short-host-name , - target-cpu get , - target-os get , - ] { } make prepend - [ 5 ] 2dip '[ - - _ >>stdin - _ >>command - short-running-process - ] retry - ] [ 2drop ] if ; +: status-notify ( report arg message -- ) + [ + short-host-name "host-name" set + target-cpu get "target-cpu" set + target-os get "target-os" set + status-secret get "secret" set + "message" set + "arg" set + "report" set + ] H{ } make-assoc + [ 5 ] dip '[ _ status-url get http-post 2drop ] retry ; : notify-heartbeat ( -- ) - f { "heartbeat" } status-notify ; + f f "heartbeat" status-notify ; : notify-begin-build ( git-id -- ) [ "Starting build of GIT ID " write print flush ] - [ f swap "git-id" swap 2array status-notify ] + [ f swap "git-id" status-notify ] bi ; : notify-make-vm ( -- ) "Compiling VM" print flush - f { "make-vm" } status-notify ; + f f "make-vm" status-notify ; : notify-boot ( -- ) "Bootstrapping" print flush - f { "boot" } status-notify ; + f f "boot" status-notify ; : notify-test ( -- ) "Running tests" print flush - f { "test" } status-notify ; + f f "test" status-notify ; : notify-report ( status -- ) [ "Build finished with status: " write . flush ] [ - [ "report" ] dip - [ [ utf8 file-contents ] dip email-report ] - [ "report" swap name>> 2array status-notify ] - 2bi + [ "report" utf8 file-contents ] dip + [ name>> "report" status-notify ] [ email-report ] 2bi ] bi ; : notify-release ( archive-name -- ) [ "Uploaded " prepend [ print flush ] [ mason-tweet ] bi ] - [ f swap "release" swap 2array status-notify ] + [ f swap "release" status-notify ] bi ; diff --git a/extra/mason/server/notify/authors.txt b/extra/mason/server/notify/authors.txt deleted file mode 100644 index d4f5d6b3ae..0000000000 --- a/extra/mason/server/notify/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov \ No newline at end of file diff --git a/extra/mason/server/notify/notify.factor b/extra/mason/server/notify/notify.factor deleted file mode 100644 index bfa1027d92..0000000000 --- a/extra/mason/server/notify/notify.factor +++ /dev/null @@ -1,80 +0,0 @@ -! Copyright (C) 2009, 2010 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors calendar combinators combinators.smart -command-line db.tuples io io.encodings.utf8 io.files kernel -mason.server namespaces present sequences ; -IN: mason.server.notify - -SYMBOLS: host-name target-os target-cpu message message-arg ; - -: parse-args ( command-line -- ) - dup last message-arg set - [ - { - [ host-name set ] - [ target-cpu set ] - [ target-os set ] - [ message set ] - } spread - ] input>host-name - target-os get >>os - target-cpu get >>cpu - dup select-tuple [ ] [ dup insert-tuple ] ?if ; - -: heartbeat ( builder -- ) now >>heartbeat-timestamp drop ; - -: git-id ( builder id -- ) >>current-git-id +starting+ >>status drop ; - -: make-vm ( builder -- ) +make-vm+ >>status drop ; - -: boot ( builder -- ) +boot+ >>status drop ; - -: test ( builder -- ) +test+ >>status drop ; - -: report ( builder status content -- ) - [ >>status ] [ >>last-report ] bi* - dup status>> +clean+ = [ - dup current-git-id>> >>clean-git-id - dup current-timestamp>> >>clean-timestamp - ] when - dup current-git-id>> >>last-git-id - dup current-timestamp>> >>last-timestamp - drop ; - -: release ( builder name -- ) - >>last-release - dup clean-git-id>> >>release-git-id - drop ; - -: update-builder ( builder -- ) - message get { - { "heartbeat" [ heartbeat ] } - { "git-id" [ message-arg get git-id ] } - { "make-vm" [ make-vm ] } - { "boot" [ boot ] } - { "test" [ test ] } - { "report" [ message-arg get contents report ] } - { "release" [ message-arg get release ] } - } case ; - -: handle-update ( command-line timestamp -- ) - [ - [ parse-args find-builder ] dip >>current-timestamp - [ update-builder ] [ update-tuple ] bi - ] with-mason-db ; - -CONSTANT: log-file "resource:mason.log" - -: log-update ( command-line timestamp -- ) - log-file utf8 [ - present write ": " write " " join print - ] with-file-appender ; - -: main ( -- ) - command-line get now [ log-update ] [ handle-update ] 2bi ; - -MAIN: main diff --git a/extra/mason/server/server.factor b/extra/mason/server/server.factor index 26be4df57c..d0fe29b917 100644 --- a/extra/mason/server/server.factor +++ b/extra/mason/server/server.factor @@ -17,8 +17,7 @@ clean-git-id clean-timestamp last-release release-git-id last-git-id last-timestamp last-report current-git-id current-timestamp -status -heartbeat-timestamp ; +status ; builder "BUILDERS" { { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } @@ -39,8 +38,6 @@ builder "BUILDERS" { ! Can't name it CURRENT_TIMESTAMP because of bug in db library { "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP } { "status" "STATUS" TEXT } - - { "heartbeat-timestamp" "HEARTBEAT_TIMESTAMP" TIMESTAMP } } define-persistent : mason-db ( -- db ) "resource:mason.db" ; diff --git a/extra/webapps/mason/download-package.xml b/extra/webapps/mason/download-package.xml index cff9dbe789..27102056f8 100644 --- a/extra/webapps/mason/download-package.xml +++ b/extra/webapps/mason/download-package.xml @@ -28,7 +28,7 @@ - + diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index ecb1348532..81eb36a17d 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -4,7 +4,7 @@ USING: accessors furnace.auth furnace.db http.server.dispatchers mason.server webapps.mason.grids webapps.mason.make-release webapps.mason.package webapps.mason.release webapps.mason.report -webapps.mason.downloads ; +webapps.mason.downloads webapps.mason.status-update ; IN: webapps.mason TUPLE: mason-app < dispatcher ; @@ -35,5 +35,7 @@ can-make-releases? define-capability "make releases" >>description { can-make-releases? } >>capabilities + "make-release" add-responder - "make-release" add-responder ; + + "status-update" add-responder ; diff --git a/extra/webapps/mason/package/package.factor b/extra/webapps/mason/package/package.factor index 5c36a7f23a..504ba7093f 100644 --- a/extra/webapps/mason/package/package.factor +++ b/extra/webapps/mason/package/package.factor @@ -66,7 +66,7 @@ IN: webapps.mason.package [ current-status "status" set-value ] [ last-build-status "last-build" set-value ] [ clean-build-status "last-clean-build" set-value ] - [ heartbeat-timestamp>> "heartbeat-timestamp" set-value ] + [ current-timestamp>> "current-timestamp" set-value ] [ packages-link "binaries" set-value ] [ clean-image-link "clean-images" set-value ] [ report-link "last-report" set-value ] diff --git a/extra/webapps/mason/status-update/authors.txt b/extra/webapps/mason/status-update/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/webapps/mason/status-update/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/webapps/mason/status-update/status-update.factor b/extra/webapps/mason/status-update/status-update.factor new file mode 100644 index 0000000000..5156b1ef70 --- /dev/null +++ b/extra/webapps/mason/status-update/status-update.factor @@ -0,0 +1,74 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors calendar combinators db.tuples furnace.actions +furnace.redirection html.forms http.server.responses io kernel +mason.config mason.server namespaces validators ; +IN: webapps.mason.status-update + +: find-builder ( -- builder ) + builder new + "host-name" value >>host-name + "target-os" value >>os + "target-cpu" value >>cpu + dup select-tuple [ ] [ dup insert-tuple ] ?if ; + +: git-id ( builder id -- ) >>current-git-id +starting+ >>status drop ; + +: make-vm ( builder -- ) +make-vm+ >>status drop ; + +: boot ( builder -- ) +boot+ >>status drop ; + +: test ( builder -- ) +test+ >>status drop ; + +: report ( builder status content -- ) + [ >>status ] [ >>last-report ] bi* + dup status>> +clean+ = [ + dup current-git-id>> >>clean-git-id + dup current-timestamp>> >>clean-timestamp + ] when + dup current-git-id>> >>last-git-id + dup current-timestamp>> >>last-timestamp + drop ; + +: release ( builder name -- ) + >>last-release + dup clean-git-id>> >>release-git-id + drop ; + +: update-builder ( builder -- ) + "message" value { + { "heartbeat" [ drop ] } + { "git-id" [ "arg" value git-id ] } + { "make-vm" [ make-vm ] } + { "boot" [ boot ] } + { "test" [ test ] } + { "report" [ "arg" value "report" value report ] } + { "release" [ "arg" value release ] } + } case ; + +: ( -- action ) + + [ + { + { "host-name" [ v-one-line ] } + { "target-cpu" [ v-one-line ] } + { "target-os" [ v-one-line ] } + { "message" [ v-one-line ] } + { "arg" [ [ v-one-line ] v-optional ] } + { "report" [ ] } + { "secret" [ v-one-line ] } + } validate-params + + "secret" value status-secret get = [ validation-failed ] unless + ] >>validate + + [ + [ + [ + find-builder + now >>current-timestamp + [ update-builder ] [ update-tuple ] bi + ] with-mason-db + "OK" "text/html" + ] if-secure + ] >>submit ; diff --git a/extra/z-algorithm/authors.txt b/extra/z-algorithm/authors.txt new file mode 100644 index 0000000000..e1702c7130 --- /dev/null +++ b/extra/z-algorithm/authors.txt @@ -0,0 +1 @@ +Dmitry Shubin diff --git a/extra/z-algorithm/summary.txt b/extra/z-algorithm/summary.txt new file mode 100644 index 0000000000..c7fadf9e81 --- /dev/null +++ b/extra/z-algorithm/summary.txt @@ -0,0 +1 @@ +Z algorithm for pattern preprocessing diff --git a/extra/z-algorithm/tags.txt b/extra/z-algorithm/tags.txt new file mode 100644 index 0000000000..49b4f2328e --- /dev/null +++ b/extra/z-algorithm/tags.txt @@ -0,0 +1 @@ +algorithms diff --git a/extra/z-algorithm/z-algorithm-docs.factor b/extra/z-algorithm/z-algorithm-docs.factor new file mode 100644 index 0000000000..395dd4952d --- /dev/null +++ b/extra/z-algorithm/z-algorithm-docs.factor @@ -0,0 +1,49 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays help.markup help.syntax sequences ; +IN: z-algorithm + +HELP: lcp +{ $values + { "seq1" sequence } { "seq2" sequence } + { "n" "a non-negative integer" } +} +{ $description + "Outputs the length of longest common prefix of two sequences." +} ; + +HELP: z-values +{ $values + { "seq" sequence } { "Z" array } +} +{ $description + "Outputs an array of the same length as " { $snippet "seq" } + ", containing Z-values for given sequence. See " + { $link "z-algorithm" } " for details." +} ; + +ARTICLE: "z-algorithm" "Z algorithm" +{ $heading "Definition" } +"Given the sequence " { $snippet "S" } " and the index " +{ $snippet "i" } ", let " { $snippet "i" } "-th Z value of " +{ $snippet "S" } " be the length of the longest subsequence of " +{ $snippet "S" } " that starts at " { $snippet "i" } +" and matches the prefix of " { $snippet "S" } "." + +{ $heading "Example" } +"Here is an example for string " { $snippet "\"abababaca\"" } ":" +{ $table + { { $snippet "i:" } "0" "1" "2" "3" "4" "5" "6" "7" "8" } + { { $snippet "S:" } "a" "b" "a" "b" "a" "b" "a" "c" "a" } + { { $snippet "Z:" } "9" "0" "5" "0" "3" "0" "1" "0" "1" } +} + +{ $heading "Summary" } +"The " { $vocab-link "z-algorithm" } +" vocabulary implements algorithm for finding all Z values for sequence " +{ $snippet "S" } +" in linear time. In contrast to naive approach which takes " +{ $snippet "Θ(n^2)" } " time." +; + +ABOUT: "z-algorithm" diff --git a/extra/z-algorithm/z-algorithm-tests.factor b/extra/z-algorithm/z-algorithm-tests.factor new file mode 100644 index 0000000000..8a8fd97480 --- /dev/null +++ b/extra/z-algorithm/z-algorithm-tests.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test z-algorithm ; +IN: z-algorithm.tests + +[ 0 ] [ "qwerty" "" lcp ] unit-test +[ 0 ] [ "qwerty" "asdf" lcp ] unit-test +[ 3 ] [ "qwerty" "qwe" lcp ] unit-test +[ 3 ] [ "qwerty" "qwet" lcp ] unit-test + +[ { } ] [ "" z-values ] unit-test +[ { 1 } ] [ "q" z-values ] unit-test +[ { 9 0 5 0 3 0 1 0 1 } ] [ "abababaca" z-values ] unit-test diff --git a/extra/z-algorithm/z-algorithm.factor b/extra/z-algorithm/z-algorithm.factor new file mode 100644 index 0000000000..bd312755a3 --- /dev/null +++ b/extra/z-algorithm/z-algorithm.factor @@ -0,0 +1,38 @@ +! Copyright (C) 2010 Dmitry Shubin. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays combinators.smart kernel locals math math.ranges +sequences sequences.private ; +IN: z-algorithm + +: lcp ( seq1 seq2 -- n ) + [ min-length ] 2keep mismatch [ nip ] when* ; + + Zk + Zk Z push seq Z + Zk 0 > [ k Zk k + 1 - ] [ l r ] if ; inline + +:: inside-zbox ( seq Z l r k -- seq Z l r ) + k l - Z nth :> Zk' + r k - 1 + :> b + seq Z Zk' b < + [ Zk' Z push l r ] ! still inside + [ + seq r 1 + seq b [ tail-slice ] 2bi@ lcp :> q + q b + Z push k q r + + ] if ; inline + +: (z-value) ( seq Z l r k -- seq Z l r ) + 2dup < [ out-of-zbox ] [ inside-zbox ] if ; inline + +:: (z-values) ( seq -- Z ) + V{ } clone 0 0 seq length :> ( Z l r len ) + len Z push [ seq Z l r 1 len [a,b) [ (z-value) ] each ] + drop-outputs Z ; inline + +PRIVATE> + +: z-values ( seq -- Z ) + dup length 0 > [ (z-values) ] when >array ; diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 6f42b4efc4..98aad10e22 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -174,8 +174,11 @@ interacting with a factor listener is at your disposal. (setq fuel-stack-mode-string "/S") (when fuel-mode-stack-p (fuel-stack-mode fuel-mode)) - (when (and fuel-mode (not (file-exists-p (buffer-file-name)))) - (fuel-scaffold--maybe-insert))) + (let ((file-name (buffer-file-name))) + (when (and fuel-mode + file-name + (not (file-exists-p file-name))) + (fuel-scaffold--maybe-insert)))) ;;; Keys:
Host name:
Last heartbeat:
Last heartbeat:
Current status:
Last build:
Last clean build: