]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor into s3
authorDaniel Ehrenberg <littledan@pool-224-36.res.carleton.edu>
Sat, 17 Apr 2010 19:05:40 +0000 (14:05 -0500)
committerDaniel Ehrenberg <littledan@pool-224-36.res.carleton.edu>
Sat, 17 Apr 2010 19:05:40 +0000 (14:05 -0500)
33 files changed:
Factor.app/Contents/Info.plist
GNUmakefile
basis/binary-search/binary-search-tests.factor
basis/binary-search/binary-search.factor
basis/compiler/tests/optimizer.factor
core/sequences/sequences-docs.factor
core/sequences/sequences.factor
extra/benchmark/binary-search/binary-search.factor
extra/benchmark/fasta/fasta.factor
extra/boyer-moore/authors.txt [new file with mode: 0644]
extra/boyer-moore/boyer-moore-docs.factor [new file with mode: 0644]
extra/boyer-moore/boyer-moore-tests.factor [new file with mode: 0644]
extra/boyer-moore/boyer-moore.factor [new file with mode: 0644]
extra/boyer-moore/summary.txt [new file with mode: 0644]
extra/boyer-moore/tags.txt [new file with mode: 0644]
extra/cuda/prefix-sum.cu [new file with mode: 0644]
extra/cuda/prefix-sum.ptx [new file with mode: 0644]
extra/elf/elf-tests.factor
extra/elf/nm/nm-tests.factor
extra/macho/a2.macho [new file with mode: 0755]
extra/macho/macho-tests.factor
extra/macho/macho.factor
extra/mason/version/files/files.factor
extra/mason/version/version.factor
extra/webapps/mason/download-package.xml
extra/webapps/mason/make-release/make-release.factor
extra/z-algorithm/authors.txt [new file with mode: 0644]
extra/z-algorithm/summary.txt [new file with mode: 0644]
extra/z-algorithm/tags.txt [new file with mode: 0644]
extra/z-algorithm/z-algorithm-docs.factor [new file with mode: 0644]
extra/z-algorithm/z-algorithm-tests.factor [new file with mode: 0644]
extra/z-algorithm/z-algorithm.factor [new file with mode: 0644]
misc/fuel/fuel-mode.el

index 1c07f95643962ceddad10d5515829684fa563c22..591886b196cdef3ca302ede890fdbe69ee59a4e5 100644 (file)
@@ -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>
index 9f93deedf290a9482c9d668c18c202b97537c6e2..30f44e9eba90bb4271d7a6015a46a570a0792613 100755 (executable)
@@ -4,7 +4,7 @@ ifdef CONFIG
        AR = ar
        LD = ld
 
-       VERSION = 0.93
+       VERSION = 0.94
 
        BUNDLE = Factor.app
        LIBPATH = -L/usr/X11R6/lib
index a797219a01466894624323ce5832c0965f4cec64..00d67dd7e3113548be2826a55ad44081c56fbee8 100644 (file)
@@ -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
index 83bf9f13f41ad1320364400f89471de811e586b5..36e983a1c8c1af71c9b00ed8f2c419f9aa6c9ab8 100644 (file)
@@ -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
 
 <PRIVATE
 
-: midpoint ( seq -- elt )
-    [ midpoint@ ] keep nth-unsafe ; inline
+:: (search) ( seq from to quot: ( elt -- <=> ) -- 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 <flat-slice> (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 )
index 2e305b2c39e99119364676c796dea8446fd11160..13917fd6bfd1be3cdf8fd8926bac9c41239f57a1 100644 (file)
@@ -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 ( -- ) ;
 
index f7f774ad8615bc2f399884327be46e732beb4466..e6c656f2da2dde6670798fbd0abc1e46d446c448 100644 (file)
@@ -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 } ;
 
index d9c234e717981842d1b565da99d2c1acc5e67af3..2155f1439fd009fb20d501fdc90b6b23216d5e5b 100644 (file)
@@ -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 )
index 5883836b7dbb229055bd4ab35f841bc127e89377..a7af66ed7e1015a4a55df6444ebbcf6b320ab554 100644 (file)
@@ -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
-memoize prettyprint sequences ;
+USING: binary-search kernel math.primes math.ranges memoize
+prettyprint sequences ;
 IN: benchmark.binary-search
 
-[
-    MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
-] with-compilation-unit
+MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
 
 ! Force computation of the primes list before benchmarking the binary search
 primes-under-million drop
index 226287974f836d528e2e2a3643c609748f885d21..8c06716ddb53f524303fd0549565437b179344cb 100644 (file)
@@ -13,7 +13,7 @@ CONSTANT: initial-seed 42
 CONSTANT: line-length 60
 
 : random ( seed -- seed n )
-    >float IA * IC + IM mod dup IM /f ; inline
+    IA * IC + IM mod dup IM /f ; inline
 
 CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
 
@@ -52,7 +52,7 @@ TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
 :: select-random ( seed chars floats -- seed elt )
     seed random floats [ <= ] with find drop chars nth-unsafe ; inline
 
-TYPED: make-random-fasta ( seed: fixnum len: fixnum chars: byte-array floats: double-array -- seed: fixnum )
+TYPED: make-random-fasta ( seed: float len: fixnum chars: byte-array floats: double-array -- seed: float )
     '[ _ _ select-random ] "" replicate-as print ;
 
 : write-description ( desc id -- )
@@ -63,7 +63,7 @@ TYPED: make-random-fasta ( seed: fixnum len: fixnum chars: byte-array floats: do
     [ [ line-length quot call ] times ] dip
     quot unless-zero ; inline
 
-TYPED: write-random-fasta ( seed: fixnum n: fixnum chars: byte-array floats: double-array desc id -- seed: fixnum )
+TYPED: write-random-fasta ( seed: float n: fixnum chars: byte-array floats: double-array desc id -- seed: float )
     write-description
     '[ _ _ make-random-fasta ] split-lines ;
 
diff --git a/extra/boyer-moore/authors.txt b/extra/boyer-moore/authors.txt
new file mode 100644 (file)
index 0000000..e1702c7
--- /dev/null
@@ -0,0 +1 @@
+Dmitry Shubin
diff --git a/extra/boyer-moore/boyer-moore-docs.factor b/extra/boyer-moore/boyer-moore-docs.factor
new file mode 100644 (file)
index 0000000..d87f431
--- /dev/null
@@ -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"
diff --git a/extra/boyer-moore/boyer-moore-tests.factor b/extra/boyer-moore/boyer-moore-tests.factor
new file mode 100644 (file)
index 0000000..e444c35
--- /dev/null
@@ -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 (file)
index 0000000..aba3f61
--- /dev/null
@@ -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 ;
diff --git a/extra/boyer-moore/summary.txt b/extra/boyer-moore/summary.txt
new file mode 100644 (file)
index 0000000..298fcc3
--- /dev/null
@@ -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 (file)
index 0000000..49b4f23
--- /dev/null
@@ -0,0 +1 @@
+algorithms
diff --git a/extra/cuda/prefix-sum.cu b/extra/cuda/prefix-sum.cu
new file mode 100644 (file)
index 0000000..a77a67f
--- /dev/null
@@ -0,0 +1,103 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <cuda_runtime.h>
+
+static const int LOG_BANK_COUNT = 4;
+
+static inline __device__ __host__ unsigned shared_offset(unsigned i)
+{
+    return i + (i >> LOG_BANK_COUNT);
+}
+
+static inline __device__ __host__ unsigned offset_a(unsigned offset, unsigned i)
+{
+    return shared_offset(offset * (2*i + 1) - 1);
+}
+
+static inline __device__ __host__ unsigned offset_b(unsigned offset, unsigned i)
+{
+    return shared_offset(offset * (2*i + 2) - 1);
+}
+
+static inline __device__ __host__ unsigned lpot(unsigned x)
+{
+    --x; x |= x>>1; x|=x>>2; x|=x>>4; x|=x>>8; x|=x>>16; return ++x;
+}
+
+template<typename T>
+__global__ void prefix_sum_block(T *in, T *out, unsigned n)
+{
+    extern __shared__ T temp[];
+
+    int idx = threadIdx.x;
+    int blocksize = blockDim.x;
+
+    temp[shared_offset(idx            )] = (idx             < n) ? in[idx            ] : 0;
+    temp[shared_offset(idx + blocksize)] = (idx + blocksize < n) ? in[idx + blocksize] : 0;
+
+    int offset, d;
+    for (offset = 1, d = blocksize; d > 0; d >>= 1, offset <<= 1) {
+        __syncthreads();
+        if (idx < d) {
+            unsigned a = offset_a(offset, idx), b = offset_b(offset, idx);
+            temp[b] += temp[a];
+        }
+    }
+
+    if (idx == 0) temp[shared_offset(blocksize*2 - 1)] = 0;
+
+    for (d = 1; d <= blocksize; d <<= 1) {
+        offset >>= 1;
+        __syncthreads();
+
+        if (idx < d) {
+            unsigned a = offset_a(offset, idx), b = offset_b(offset, idx);
+            unsigned t = temp[a];
+            temp[a] = temp[b];
+            temp[b] += t;
+        }
+    }
+    __syncthreads();
+
+    if (idx             < n) out[idx            ] = temp[shared_offset(idx            )];
+    if (idx + blocksize < n) out[idx + blocksize] = temp[shared_offset(idx + blocksize)];
+}
+
+template<typename T>
+void prefix_sum(T *in, T *out, unsigned n)
+{
+    char *device_values;
+    unsigned n_lpot = lpot(n);
+    size_t n_pitch;
+
+    cudaError_t error = cudaMallocPitch((void**)&device_values, &n_pitch, sizeof(T)*n, 2);
+    if (error != 0) {
+        printf("error %u allocating width %lu height %u\n", error, sizeof(T)*n, 2);
+        exit(1);
+    }
+
+    cudaMemcpy(device_values, in, sizeof(T)*n, cudaMemcpyHostToDevice);
+
+    prefix_sum_block<<<1, n_lpot/2, shared_offset(n_lpot)*sizeof(T)>>>
+        ((T*)device_values, (T*)(device_values + n_pitch), n);
+
+    cudaMemcpy(out, device_values + n_pitch, sizeof(T)*n, cudaMemcpyDeviceToHost);
+    cudaFree(device_values);
+}
+
+int main()
+{
+    sranddev();
+
+    static unsigned in_values[1024], out_values[1024];
+
+    for (int i = 0; i < 1024; ++i)
+        in_values[i] = rand() >> 21;
+
+    prefix_sum(in_values, out_values, 1024);
+
+    for (int i = 0; i < 1024; ++i)
+        printf("%5d => %5d\n", in_values[i], out_values[i]);
+
+    return 0;
+}
diff --git a/extra/cuda/prefix-sum.ptx b/extra/cuda/prefix-sum.ptx
new file mode 100644 (file)
index 0000000..d189179
--- /dev/null
@@ -0,0 +1,222 @@
+       .version 1.4
+       .target sm_10, map_f64_to_f32
+       // compiled with /usr/local/cuda/bin/../open64/lib//be
+       // nvopencc 3.0 built on 2010-03-11
+
+       //-----------------------------------------------------------
+       // Compiling /tmp/tmpxft_00000236_00000000-7_prefix-sum.cpp3.i (/var/folders/K6/K6oI14wZ2RWhSE+BYqTjA++++TI/-Tmp-/ccBI#.0ATpGM)
+       //-----------------------------------------------------------
+
+       //-----------------------------------------------------------
+       // Options:
+       //-----------------------------------------------------------
+       //  Target:ptx, ISA:sm_10, Endian:little, Pointer Size:32
+       //  -O3 (Optimization level)
+       //  -g0 (Debug level)
+       //  -m2 (Report advisories)
+       //-----------------------------------------------------------
+
+       .file   1       "<command-line>"
+       .file   2       "/tmp/tmpxft_00000236_00000000-6_prefix-sum.cudafe2.gpu"
+       .file   3       "/usr/lib/gcc/i686-apple-darwin10/4.2.1/include/stddef.h"
+       .file   4       "/usr/local/cuda/bin/../include/crt/device_runtime.h"
+       .file   5       "/usr/local/cuda/bin/../include/host_defines.h"
+       .file   6       "/usr/local/cuda/bin/../include/builtin_types.h"
+       .file   7       "/usr/local/cuda/bin/../include/device_types.h"
+       .file   8       "/usr/local/cuda/bin/../include/driver_types.h"
+       .file   9       "/usr/local/cuda/bin/../include/texture_types.h"
+       .file   10      "/usr/local/cuda/bin/../include/vector_types.h"
+       .file   11      "/usr/local/cuda/bin/../include/device_launch_parameters.h"
+       .file   12      "/usr/local/cuda/bin/../include/crt/storage_class.h"
+       .file   13      "/usr/include/i386/_types.h"
+       .file   14      "/usr/include/time.h"
+       .file   15      "prefix-sum.cu"
+       .file   16      "/usr/local/cuda/bin/../include/common_functions.h"
+       .file   17      "/usr/local/cuda/bin/../include/crt/func_macro.h"
+       .file   18      "/usr/local/cuda/bin/../include/math_functions.h"
+       .file   19      "/usr/local/cuda/bin/../include/device_functions.h"
+       .file   20      "/usr/local/cuda/bin/../include/math_constants.h"
+       .file   21      "/usr/local/cuda/bin/../include/sm_11_atomic_functions.h"
+       .file   22      "/usr/local/cuda/bin/../include/sm_12_atomic_functions.h"
+       .file   23      "/usr/local/cuda/bin/../include/sm_13_double_functions.h"
+       .file   24      "/usr/local/cuda/bin/../include/common_types.h"
+       .file   25      "/usr/local/cuda/bin/../include/sm_20_atomic_functions.h"
+       .file   26      "/usr/local/cuda/bin/../include/sm_20_intrinsics.h"
+       .file   27      "/usr/local/cuda/bin/../include/texture_fetch_functions.h"
+       .file   28      "/usr/local/cuda/bin/../include/math_functions_dbl_ptx1.h"
+
+       .extern .shared .align 4 .b8 temp[];
+
+       .entry _Z16prefix_sum_blockIjEvPT_S1_j (
+               .param .u32 __cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_in,
+               .param .u32 __cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_out,
+               .param .u32 __cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_n)
+       {
+       .reg .u32 %r<81>;
+       .reg .pred %p<11>;
+       .loc    15      28      0
+$LBB1__Z16prefix_sum_blockIjEvPT_S1_j:
+       ld.param.u32    %r1, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_n];
+       cvt.s32.u16     %r2, %tid.x;
+       setp.lt.u32     %p1, %r2, %r1;
+       @!%p1 bra       $Lt_0_7938;
+       .loc    15      35      0
+       ld.param.u32    %r3, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_in];
+       mul24.lo.u32    %r4, %r2, 4;
+       add.u32         %r5, %r3, %r4;
+       ld.global.u32   %r6, [%r5+0];
+       bra.uni         $Lt_0_7682;
+$Lt_0_7938:
+       mov.u32         %r6, 0;
+$Lt_0_7682:
+       mov.u32         %r7, temp;
+       shr.u32         %r8, %r2, 4;
+       add.u32         %r9, %r2, %r8;
+       mul.lo.u32      %r10, %r9, 4;
+       add.u32         %r11, %r10, %r7;
+       st.shared.u32   [%r11+0], %r6;
+       cvt.s32.u16     %r12, %ntid.x;
+       add.s32         %r13, %r12, %r2;
+       .loc    15      28      0
+       ld.param.u32    %r1, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_n];
+       .loc    15      35      0
+       setp.lt.u32     %p2, %r13, %r1;
+       @!%p2 bra       $Lt_0_8450;
+       .loc    15      36      0
+       ld.param.u32    %r14, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_in];
+       mul.lo.u32      %r15, %r13, 4;
+       add.u32         %r16, %r14, %r15;
+       ld.global.u32   %r17, [%r16+0];
+       bra.uni         $Lt_0_8194;
+$Lt_0_8450:
+       mov.u32         %r17, 0;
+$Lt_0_8194:
+       shr.u32         %r18, %r13, 4;
+       add.u32         %r19, %r13, %r18;
+       mul.lo.u32      %r20, %r19, 4;
+       add.u32         %r21, %r20, %r7;
+       st.shared.u32   [%r21+0], %r17;
+       .loc    15      39      0
+       mov.s32         %r22, %r12;
+       mov.u32         %r23, 0;
+       setp.le.s32     %p3, %r12, %r23;
+       mov.s32         %r24, 1;
+       @%p3 bra        $Lt_0_13314;
+$Lt_0_9218:
+ //<loop> Loop body line 39, nesting depth: 1, estimated iterations: unknown
+       .loc    15      40      0
+       bar.sync        0;
+       setp.le.s32     %p4, %r22, %r2;
+       @%p4 bra        $Lt_0_9474;
+ //<loop> Part of loop body line 39, head labeled $Lt_0_9218
+       .loc    15      43      0
+       mul24.lo.u32    %r25, %r2, 2;
+       add.u32         %r26, %r25, 1;
+       add.u32         %r27, %r25, 2;
+       mul.lo.u32      %r28, %r24, %r26;
+       mul.lo.u32      %r29, %r24, %r27;
+       sub.u32         %r30, %r29, 1;
+       shr.u32         %r31, %r30, 4;
+       add.u32         %r32, %r29, %r31;
+       mul.lo.u32      %r33, %r32, 4;
+       add.u32         %r34, %r33, %r7;
+       ld.shared.u32   %r35, [%r34+-4];
+       sub.u32         %r36, %r28, 1;
+       shr.u32         %r37, %r36, 4;
+       add.u32         %r38, %r28, %r37;
+       mul.lo.u32      %r39, %r38, 4;
+       add.u32         %r40, %r7, %r39;
+       ld.shared.u32   %r41, [%r40+-4];
+       add.u32         %r42, %r35, %r41;
+       st.shared.u32   [%r34+-4], %r42;
+$Lt_0_9474:
+ //<loop> Part of loop body line 39, head labeled $Lt_0_9218
+       .loc    15      39      0
+       shr.s32         %r22, %r22, 1;
+       shl.b32         %r24, %r24, 1;
+       mov.u32         %r43, 0;
+       setp.gt.s32     %p5, %r22, %r43;
+       @%p5 bra        $Lt_0_9218;
+       bra.uni         $Lt_0_8706;
+$Lt_0_13314:
+$Lt_0_8706:
+       mov.u32         %r44, 0;
+       setp.ne.s32     %p6, %r2, %r44;
+       @%p6 bra        $Lt_0_10242;
+       .loc    15      47      0
+       mul24.lo.s32    %r45, %r12, 2;
+       mov.u32         %r46, 0;
+       sub.u32         %r47, %r45, 1;
+       shr.u32         %r48, %r47, 4;
+       add.u32         %r49, %r45, %r48;
+       mul.lo.u32      %r50, %r49, 4;
+       add.u32         %r51, %r7, %r50;
+       st.shared.u32   [%r51+-4], %r46;
+$Lt_0_10242:
+       mov.u32         %r52, 1;
+       setp.lt.s32     %p7, %r12, %r52;
+       @%p7 bra        $Lt_0_10754;
+       mov.s32         %r22, 1;
+$Lt_0_11266:
+ //<loop> Loop body line 47, nesting depth: 1, estimated iterations: unknown
+       .loc    15      50      0
+       shr.s32         %r24, %r24, 1;
+       .loc    15      51      0
+       bar.sync        0;
+       setp.le.s32     %p8, %r22, %r2;
+       @%p8 bra        $Lt_0_11522;
+ //<loop> Part of loop body line 47, head labeled $Lt_0_11266
+       .loc    15      55      0
+       mul24.lo.u32    %r53, %r2, 2;
+       add.u32         %r54, %r53, 1;
+       mul.lo.u32      %r55, %r24, %r54;
+       sub.u32         %r56, %r55, 1;
+       shr.u32         %r57, %r56, 4;
+       add.u32         %r58, %r55, %r57;
+       mul.lo.u32      %r59, %r58, 4;
+       add.u32         %r60, %r59, %r7;
+       ld.shared.u32   %r61, [%r60+-4];
+       .loc    15      56      0
+       add.u32         %r62, %r53, 2;
+       mul.lo.u32      %r63, %r24, %r62;
+       sub.u32         %r64, %r63, 1;
+       shr.u32         %r65, %r64, 4;
+       add.u32         %r66, %r63, %r65;
+       mul.lo.u32      %r67, %r66, 4;
+       add.u32         %r68, %r67, %r7;
+       ld.shared.u32   %r69, [%r68+-4];
+       st.shared.u32   [%r60+-4], %r69;
+       .loc    15      57      0
+       ld.shared.u32   %r70, [%r68+-4];
+       add.u32         %r71, %r70, %r61;
+       st.shared.u32   [%r68+-4], %r71;
+$Lt_0_11522:
+ //<loop> Part of loop body line 47, head labeled $Lt_0_11266
+       .loc    15      49      0
+       shl.b32         %r22, %r22, 1;
+       setp.le.s32     %p9, %r22, %r12;
+       @%p9 bra        $Lt_0_11266;
+$Lt_0_10754:
+       .loc    15      60      0
+       bar.sync        0;
+       @!%p1 bra       $Lt_0_12290;
+       .loc    15      62      0
+       ld.shared.u32   %r72, [%r11+0];
+       ld.param.u32    %r73, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_out];
+       mul24.lo.u32    %r74, %r2, 4;
+       add.u32         %r75, %r73, %r74;
+       st.global.u32   [%r75+0], %r72;
+$Lt_0_12290:
+       @!%p2 bra       $Lt_0_12802;
+       .loc    15      63      0
+       ld.shared.u32   %r76, [%r21+0];
+       ld.param.u32    %r77, [__cudaparm__Z16prefix_sum_blockIjEvPT_S1_j_out];
+       mul.lo.u32      %r78, %r13, 4;
+       add.u32         %r79, %r77, %r78;
+       st.global.u32   [%r79+0], %r76;
+$Lt_0_12802:
+       .loc    15      64      0
+       exit;
+$LDWend__Z16prefix_sum_blockIjEvPT_S1_j:
+       } // _Z16prefix_sum_blockIjEvPT_S1_j
+
index d68885e6b7a67ee0fae93f187f28aedb92e9b91f..4d1bb5be061e3eb8bf4215048c13685224a50acc 100644 (file)
@@ -1,8 +1,9 @@
 ! Copyright (C) 2010 Erik Charlebois.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays elf kernel sequences tools.test ;
+USING: accessors byte-arrays elf kernel sequences system tools.test ;
 IN: elf.tests
 
+cpu ppc? [
 {
     {
         ""
@@ -178,3 +179,4 @@ unit-test
     ] with-mapped-elf
 ]
 unit-test
+] unless
index 9e529ae43d8f71f8ceab6738ce8492e926cd1882..90d9634750149bc1b36ff2577bb8c8b9eb1a9da2 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2010 Erik Charlebois.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: elf.nm io io.streams.string kernel multiline strings tools.test
-literals ;
+USING: elf.nm io io.streams.string kernel literals multiline strings
+system tools.test ;
 IN: elf.nm.tests
 
 STRING: validation-output
@@ -46,6 +46,8 @@ STRING: validation-output
 
 ;
 
-{ $ validation-output }
-[ <string-writer> dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ]
-unit-test
+cpu ppc? [
+    { $ validation-output }
+    [ <string-writer> dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ]
+    unit-test
+] unless
diff --git a/extra/macho/a2.macho b/extra/macho/a2.macho
new file mode 100755 (executable)
index 0000000..ed9a3a9
Binary files /dev/null and b/extra/macho/a2.macho differ
index ca60d3dc9b31a04cb134d83f3bc01bb5997ea6c6..561a98cd706621283701a7af6efe223e396bff99 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2010 Erik Charlebois.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.streams.string kernel literals macho multiline strings
-tools.test ;
+USING: accessors alien io io.streams.string kernel literals macho
+multiline sequences strings system tools.test ;
 IN: macho.tests
 
 STRING: validation-output
@@ -21,6 +21,14 @@ STRING: validation-output
 
 ;
 
-{ $ validation-output }
-[ <string-writer> dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ]
-unit-test
+cpu ppc? [
+    { $ validation-output }
+    [ <string-writer> dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ]
+    unit-test
+    
+    { t } [
+        "resource:extra/macho/a2.macho" [
+            >c-ptr fat-binary-members first data>> >c-ptr macho-header 64-bit?
+        ] with-mapped-macho
+    ] unit-test
+] unless
index 79cb59c148d518e3c88a851c7e1ca9c72556cfcd..70dc594e07b189a8f862210afded1b13db2e75fa 100644 (file)
@@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.strings alien.syntax
 classes classes.struct combinators combinators.short-circuit
 io.encodings.ascii io.encodings.string kernel literals make
 math sequences specialized-arrays typed fry io.mmap formatting
-locals splitting ;
+locals splitting io.binary arrays ;
 FROM: alien.c-types => short ;
 IN: macho
 
@@ -812,7 +812,7 @@ C-ENUM: reloc_type_ppc
     PPC_RELOC_LOCAL_SECTDIFF ;
 
 ! Low-level interface
-SPECIALIZED-ARRAYS: section section_64 nlist nlist_64 ;
+SPECIALIZED-ARRAYS: section section_64 nlist nlist_64 fat_arch uchar ;
 UNION: mach_header_32/64 mach_header mach_header_64 ;
 UNION: segment_command_32/64 segment_command segment_command_64 ;
 UNION: load-command segment_command segment_command_64
@@ -826,6 +826,26 @@ UNION: section_32/64-array section-array section_64-array ;
 UNION: nlist_32/64 nlist nlist_64 ;
 UNION: nlist_32/64-array nlist-array nlist_64-array ;
 
+TUPLE: fat-binary-member cpu-type cpu-subtype data ;
+ERROR: not-fat-binary ;
+
+TYPED: fat-binary-members ( >c-ptr -- fat-binary-members )
+    fat_header memory>struct dup magic>> {
+        { FAT_MAGIC [ ] }
+        { FAT_CIGAM [ ] }
+        [ 2drop not-fat-binary ]
+    } case dup
+    [ >c-ptr fat_header heap-size swap <displaced-alien> ]
+    [ nfat_arch>> 4 >be le> ] bi
+    <direct-fat_arch-array> [
+        {
+            [ nip cputype>> 4 >be le> ]
+            [ nip cpusubtype>> 4 >be le> ]
+            [ offset>> 4 >be le> swap >c-ptr <displaced-alien> ]
+            [ nip size>> 4 >be le> <direct-uchar-array> ]
+        } 2cleave fat-binary-member boa
+    ] with { } map-as ;
+
 TYPED: 64-bit? ( macho: mach_header_32/64 -- ? )
     magic>> {
         { MH_MAGIC_64 [ t ] }
@@ -924,12 +944,13 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands )
 : macho-nm ( path -- )
     [| macho |
         macho load-commands segment-commands sections-array :> sections
-        
         macho load-commands symtab-commands [| symtab |
             macho symtab symbols [
                 [ drop n_value>> "%016x " printf ]
-                [ drop n_sect>> sections nth sectname>>
-                  read-array-string "%-16s" printf ]
+                [
+                    drop n_sect>> sections nth sectname>>
+                    read-array-string "%-16s" printf
+                ]
                 [ symbol-name "%s\n" printf ] 2tri
             ] curry each
         ] each
index 1335885c3d7f5ab5b5a6501d9ca95c0fe24c5cf3..ba09c6274cdc195e8ce6737813c01435578c6e31 100644 (file)
@@ -10,9 +10,6 @@ IN: mason.version.files
 : remote-directory ( string -- string' )
     [ upload-directory get ] dip "/" glue ;
 
-: remote ( string version -- string )
-    remote-directory swap "/" glue ;
-
 : platform ( builder -- string )
     [ os>> ] [ cpu>> ] bi (platform) ;
 
@@ -30,10 +27,10 @@ IN: mason.version.files
     ] [ drop ] 2bi release-directory ;
 
 : remote-binary-release-name ( version builder -- string )
-    [ binary-release-name ] [ drop ] 2bi remote ;
+    binary-release-name remote-directory ;
 
 : source-release-name ( version -- string )
     [ "factor-src-" ".zip" surround ] keep release-directory ;
 
 : remote-source-release-name ( version -- string )
-    [ source-release-name ] keep remote ;
+    source-release-name remote-directory ;
index a2093124f7f03e095102d03b4c3c197c666205b4..bb0fcbf2c32037c9832f1d5fc0c88185a34789be 100644 (file)
@@ -13,7 +13,7 @@ IN: mason.version
 
 : make-release-directory ( version -- )
     "Creating release directory..." print flush
-    [ "mkdir -p " % "" release-directory % "\n" % ] "" make
+    [ "mkdir -p " % "" release-directory remote-directory % "\n" % ] "" make
     execute-on-server ;
 
 : tweet-release ( version announcement-url -- )
index cff9dbe78938c41f9b9a6480bd25e6e921c74868..43212cfc617539dc9edf8cf2b4f5c37f2868ebe9 100644 (file)
@@ -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="heartbeat-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>
index c90aaad297939ad7a6935f91b83cc665835d7b2a..e7cd13a8951a980818443a30cb35ab5ce5e583cb 100644 (file)
@@ -6,7 +6,12 @@ IN: webapps.mason.make-release
 
 : <make-release-action> ( -- action )
     <page-action>
-    [ { { "version" [ v-one-line ] } } validate-params ] >>validate
+    [
+        {
+            { "version" [ v-one-line ] }
+            { "announcement-url" [ v-url ] }
+        } validate-params
+    ] >>validate
     [
         [
             "version" value "announcement-url" value do-release
diff --git a/extra/z-algorithm/authors.txt b/extra/z-algorithm/authors.txt
new file mode 100644 (file)
index 0000000..e1702c7
--- /dev/null
@@ -0,0 +1 @@
+Dmitry Shubin
diff --git a/extra/z-algorithm/summary.txt b/extra/z-algorithm/summary.txt
new file mode 100644 (file)
index 0000000..c7fadf9
--- /dev/null
@@ -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 (file)
index 0000000..49b4f23
--- /dev/null
@@ -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 (file)
index 0000000..395dd49
--- /dev/null
@@ -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 (file)
index 0000000..8a8fd97
--- /dev/null
@@ -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 (file)
index 0000000..bd31275
--- /dev/null
@@ -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 ;
index 6f42b4efc423880aec89563848e4e926e1f780e2..98aad10e22f57a7af9360c17b10fa5f769833a54 100644 (file)
@@ -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))))
 
 \f
 ;;; Keys: