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

Factor.app/Contents/Info.plist

@@ -32,7 +32,7 @@
 	<key>CFBundlePackageType</key>
 	<string>APPL</string>
 	<key>CFBundleVersion</key>
-	<string>0.93</string>
+	<string>0.94</string>
 	<key>NSHumanReadableCopyright</key>
 	<string>Copyright © 2003-2010 Factor developers</string>
 	<key>NSServices</key>

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

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

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
+USING: accessors arrays combinators hints kernel locals math
-math.order combinators hints arrays ;
+math.order sequences ;
 IN: binary-search
 
 <PRIVATE
 
-: midpoint ( seq -- elt )
+:: (search) ( seq from to quot: ( elt -- <=> ) -- i elt )
-    [ midpoint@ ] keep nth-unsafe ; inline
+    from to + 2/ :> midpoint@
+    midpoint@ seq nth :> midpoint
 
-: decide ( quot seq -- quot seq <=> )
+    to from - 1 <= [
-    [ midpoint swap call ] 2keep rot ; inline
+        midpoint@ midpoint
-
-: 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
     ] [
-        decide {
+        midpoint quot call {
-            { +eq+ [ finish ] }
+            { +eq+ [ midpoint@ midpoint ] }
-            { +lt+ [ [ (head) ] keep-searching ] }
+            { +lt+ [ seq from midpoint@ quot (search) ] }
-            { +gt+ [ [ (tail) ] keep-searching ] }
+            { +gt+ [ seq midpoint@ to quot (search) ] }
         } case
     ] if ; inline recursive
 
 PRIVATE>
 
-: search ( seq quot -- i elt )
+: search ( seq quot: ( elt -- <=> ) -- i elt )
-    over empty? [ 2drop f f ] [ swap <flat-slice> (search) ] if ;
+    over empty? [ 2drop f f ] [ [ 0 over length ] dip (search) ] if ;
     inline
 
 : natural-search ( obj seq -- i elt )

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 <flat-slice>
-    [ [ - ] swap old-binsearch ] compile-call 2nip
-] unit-test
-
 ! Regression
 : empty-compound ( -- ) ;
 

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: <flat-slice>
-{ $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: <slice>
 { $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 <flat-slice> } " 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 <slice> } "." } ;
 
 { <slice> 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 <flat-slice> }
 "Replacing slices with new elements:"
 { $subsections replace-slice } ;
 

core/sequences/sequences.factor

@@ -898,11 +898,6 @@ PRIVATE>
 : unclip-last-slice ( seq -- butlast-slice last )
     [ but-last-slice ] [ last ] bi ; inline
 
-: <flat-slice> ( seq -- slice )
-    dup slice? [ { } like ] when
-    [ drop 0 ] [ length ] [ ] tri <slice> ;
-    inline
-
 <PRIVATE
     
 : (trim-head) ( seq quot -- seq n )

extra/benchmark/binary-search/binary-search.factor

@@ -1,12 +1,10 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: binary-search compiler.units kernel math.primes math.ranges
+USING: binary-search kernel math.primes math.ranges memoize
-memoize prettyprint sequences ;
+prettyprint sequences ;
 IN: benchmark.binary-search
 
-[
+MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
-    MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
-] with-compilation-unit
 
 ! Force computation of the primes list before benchmarking the binary search
 primes-under-million drop

extra/boyer-moore/authors.txt

@@ -0,0 +1 @@
+Dmitry Shubin

extra/boyer-moore/boyer-moore-docs.factor

@@ -0,0 +1,59 @@
+! Copyright (C) 2010 Dmitry Shubin.
+! See http://factorcode.org/license.txt for BSD license.
+USING: boyer-moore.private help.markup help.syntax kernel sequences ;
+IN: boyer-moore
+
+HELP: <boyer-moore>
+{ $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"

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

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
+
+<PRIVATE
+
+:: (normal-suffixes) ( i zs ss -- )
+    i zs nth-unsafe ss
+    [ [ i ] unless* ] change-nth-unsafe ; inline
+
+: normal-suffixes ( zs -- ss )
+    [ length [ f <array> ] [ [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 ] [ <reversed> ] bi
+    [ (partial-suffixes) ] map-index 2nip ; inline
+
+: <gs-table> ( 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
+
+: <bc-table> ( 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>
+
+: <boyer-moore> ( pat -- bm )
+    dup <reversed> [ <bc-table> ] [ <gs-table> ] bi
+    boyer-moore boa ;
+
+GENERIC: search-from ( seq from obj -- i/f )
+
+M: sequence search-from
+    dup length zero?
+    [ 3drop 0 ] [ <boyer-moore> (search-from) ] if ;
+
+M: boyer-moore search-from (search-from) ;
+
+: search ( seq obj -- i/f ) [ 0 ] dip search-from ;

extra/boyer-moore/summary.txt

@@ -0,0 +1 @@
+Boyer-Moore string search algorithm

extra/boyer-moore/tags.txt

@@ -0,0 +1 @@
+algorithms

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.
+! URL for status notifications.
-SYMBOL: status-host
+SYMBOL: status-url
 
-! Username to log in.
+! Password for status notifications.
-SYMBOL: status-username
+SYMBOL: status-secret
 
 SYMBOL: upload-help?
 

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
+USING: accessors fry http.client io io.encodings.utf8 io.files
-io.launcher kernel make mason.config mason.common mason.email
+kernel mason.common mason.config mason.email mason.twitter
-mason.twitter namespaces sequences prettyprint fry ;
+namespaces prettyprint sequences ;
 IN: mason.notify
 
-: status-notify ( input-file args -- )
+: status-notify ( report arg message -- )
-    status-host get [
+    [
-        [
+        short-host-name "host-name" set
-            "ssh" , status-host get , "-l" , status-username get ,
+        target-cpu get "target-cpu" set
-            "./mason-notify" ,
+        target-os get "target-os" set
-            short-host-name ,
+        status-secret get "secret" set
-            target-cpu get ,
+        "message" set
-            target-os get ,
+        "arg" set
-        ] { } make prepend
+        "report" set
-        [ 5 ] 2dip '[
+    ] H{ } make-assoc
-            <process>
+    [ 5 ] dip '[ _ status-url get http-post 2drop ] retry ;
-                _ >>stdin
-                _ >>command
-            short-running-process
-        ] retry
-    ] [ 2drop ] if ;
 
 : 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
+        [ "report" utf8 file-contents ] dip
-        [ [ utf8 file-contents ] dip email-report ]
+        [ name>> "report" status-notify ] [ email-report ] 2bi
-        [ "report" swap name>> 2array status-notify ]
-        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 ;

extra/mason/server/notify/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

extra/mason/server/notify/notify.factor

@@ -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<sequence ;
-
-: find-builder ( -- builder )
-    builder new
-        host-name get >>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

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
+status ;
-heartbeat-timestamp ;
 
 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" <sqlite-db> ;

extra/webapps/mason/download-package.xml

@@ -28,7 +28,7 @@
 
     <table border="1">
       <tr><td>Host name:</td><td><t:xml t:name="host-name" /></td></tr>
-      <tr><td>Last heartbeat:</td><td><t:xml t:name="last-heartbeat" /></td></tr>
+      <tr><td>Last heartbeat:</td><td><t:label t:name="current-timestamp" /></td></tr>
       <tr><td>Current status:</td><td><t:xml t:name="status" /></td></tr>
       <tr><td>Last build:</td><td><t:xml t:name="last-build" /></td></tr>
       <tr><td>Last clean build:</td><td><t:xml t:name="last-clean-build" /></td></tr>

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
         <protected>
             "make releases" >>description
             { can-make-releases? } >>capabilities
+        "make-release" add-responder
 
-        "make-release" add-responder ;
+    <status-update-action>
+        "status-update" add-responder ;

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 ]

extra/webapps/mason/status-update/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

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 ;
+
+: <status-update-action> ( -- action )
+    <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" <content>
+        ] if-secure
+    ] >>submit ;

extra/z-algorithm/authors.txt

@@ -0,0 +1 @@
+Dmitry Shubin

extra/z-algorithm/summary.txt

@@ -0,0 +1 @@
+Z algorithm for pattern preprocessing

extra/z-algorithm/tags.txt

@@ -0,0 +1 @@
+algorithms

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"

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

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* ;
+
+<PRIVATE
+
+:: out-of-zbox ( seq Z l r k -- seq Z l r )
+    seq k tail-slice seq lcp :> 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 ;

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))))
+  (let ((file-name (buffer-file-name)))
-    (fuel-scaffold--maybe-insert)))
+    (when (and fuel-mode
+               file-name
+               (not (file-exists-p file-name)))
+      (fuel-scaffold--maybe-insert))))
 
 
 ;;; Keys: