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 - 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 index 0000000000..e1702c7130 --- /dev/null +++ b/extra/boyer-moore/authors.txt @@ -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 index 0000000000..d87f431ee7 --- /dev/null +++ b/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: +{ $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/cuda/prefix-sum.cu b/extra/cuda/prefix-sum.cu new file mode 100644 index 0000000000..a77a67f035 --- /dev/null +++ b/extra/cuda/prefix-sum.cu @@ -0,0 +1,103 @@ +#include +#include +#include + +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 +__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 +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 index 0000000000..d18917965d --- /dev/null +++ b/extra/cuda/prefix-sum.ptx @@ -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 "" + .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 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; + // 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: + // 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 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; + // 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: + // 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 + diff --git a/extra/elf/elf-tests.factor b/extra/elf/elf-tests.factor index d68885e6b7..4d1bb5be06 100644 --- a/extra/elf/elf-tests.factor +++ b/extra/elf/elf-tests.factor @@ -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 diff --git a/extra/elf/nm/nm-tests.factor b/extra/elf/nm/nm-tests.factor index 9e529ae43d..90d9634750 100644 --- a/extra/elf/nm/nm-tests.factor +++ b/extra/elf/nm/nm-tests.factor @@ -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 } -[ dup [ "resource:extra/elf/a.elf" elf-nm ] with-output-stream >string ] -unit-test +cpu ppc? [ + { $ validation-output } + [ 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 index 0000000000..ed9a3a9a27 Binary files /dev/null and b/extra/macho/a2.macho differ diff --git a/extra/macho/macho-tests.factor b/extra/macho/macho-tests.factor index ca60d3dc9b..561a98cd70 100644 --- a/extra/macho/macho-tests.factor +++ b/extra/macho/macho-tests.factor @@ -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 } -[ dup [ "resource:extra/macho/a.macho" macho-nm ] with-output-stream >string ] -unit-test +cpu ppc? [ + { $ validation-output } + [ 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 diff --git a/extra/macho/macho.factor b/extra/macho/macho.factor index 79cb59c148..70dc594e07 100644 --- a/extra/macho/macho.factor +++ b/extra/macho/macho.factor @@ -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 ] + [ nfat_arch>> 4 >be le> ] bi + [ + { + [ nip cputype>> 4 >be le> ] + [ nip cpusubtype>> 4 >be le> ] + [ offset>> 4 >be le> swap >c-ptr ] + [ nip size>> 4 >be le> ] + } 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 diff --git a/extra/mason/version/files/files.factor b/extra/mason/version/files/files.factor index 1335885c3d..ba09c6274c 100644 --- a/extra/mason/version/files/files.factor +++ b/extra/mason/version/files/files.factor @@ -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 ; diff --git a/extra/mason/version/version.factor b/extra/mason/version/version.factor index a2093124f7..bb0fcbf2c3 100644 --- a/extra/mason/version/version.factor +++ b/extra/mason/version/version.factor @@ -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 -- ) diff --git a/extra/webapps/mason/download-package.xml b/extra/webapps/mason/download-package.xml index cff9dbe789..43212cfc61 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/make-release/make-release.factor b/extra/webapps/mason/make-release/make-release.factor index c90aaad297..e7cd13a895 100644 --- a/extra/webapps/mason/make-release/make-release.factor +++ b/extra/webapps/mason/make-release/make-release.factor @@ -6,7 +6,12 @@ IN: webapps.mason.make-release : ( -- 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 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: