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

core/sequences/sequences-docs.factor

@@ -286,7 +286,7 @@ $nl
 
 HELP: accumulate
 { $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( ... prev elt -- ... next )" } } { "final" "the final result" } { "newseq" "a new array" } }
-{ $description "Combines successive elements of the sequence using a binary operation, and outputs an array of intermediate results, together with the final result."
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of intermediate results, together with the final result."
 $nl
 "The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
 $nl

core/sequences/sequences-tests.factor

@@ -24,6 +24,9 @@ IN: sequences.tests
 [ 5040 { 1 1 2 6 24 120 720 } ]
 [ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate ] unit-test
 
+[ 64 B{ 1 2 4 16 } ]
+[ B{ 2 2 4 4 } 1 [ * ] accumulate ] unit-test
+
 [ 5040 { 1 1 2 6 24 120 720 } ]
 [ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate! ] unit-test
 

core/sequences/sequences.factor

@@ -436,7 +436,7 @@ PRIVATE>
     [ (accumulate) ] dip map-as ; inline
 
 : accumulate ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... final newseq )
-    { } accumulate-as ; inline
+    pick accumulate-as ; inline
 
 : accumulate! ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... final seq )
     (accumulate) map! ; inline

extra/benchmark/fasta/fasta.factor

@@ -1,8 +1,9 @@
 ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
-USING: alien.c-types math kernel io io.files locals multiline
+USING: assocs benchmark.reverse-complement byte-arrays fry io
-assocs sequences sequences.private benchmark.reverse-complement
+io.encodings.ascii io.files locals kernel math sequences
-hints io.encodings.ascii byte-arrays specialized-arrays ;
+sequences.private specialized-arrays strings typed ;
-SPECIALIZED-ARRAY: double
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:double
 IN: benchmark.fasta
 
 CONSTANT: IM 139968
@@ -11,10 +12,8 @@ CONSTANT: IC 29573
 CONSTANT: initial-seed 42
 CONSTANT: line-length 60
 
-: random ( seed -- n seed )
+: random ( seed -- seed n )
-    >float IA * IC + IM mod [ IM /f ] keep ; inline
+    >float IA * IC + IM mod dup IM /f ; inline
-
-HINTS: random fixnum ;
 
 CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
 
@@ -46,34 +45,32 @@ CONSTANT: homo-sapiens
         { CHAR: t 0.3015094502008 }
     }
 
-: make-cumulative ( freq -- chars floats )
+TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
     [ keys >byte-array ]
-    [ values >double-array ] bi unclip [ + ] accumulate swap suffix ;
+    [ values >double-array unclip [ + ] accumulate swap suffix ] bi ;
 
 :: select-random ( seed chars floats -- seed elt )
-    floats seed random -rot
+    seed random floats [ <= ] with find drop chars nth-unsafe ; inline
-    [ >= ] curry find drop
-    chars nth-unsafe ; inline
 
-: make-random-fasta ( seed len chars floats -- seed )
+TYPED: make-random-fasta ( seed: fixnum len: fixnum chars: byte-array floats: double-array -- seed: fixnum )
-    [ iota ] 2dip [ [ drop ] 2dip select-random ] 2curry "" map-as print ; inline
+    '[ _ _ select-random ] "" replicate-as print ;
 
 : write-description ( desc id -- )
-    ">" write write bl print ; inline
+    ">" write write bl print ;
 
 :: split-lines ( n quot -- )
     n line-length /mod
     [ [ line-length quot call ] times ] dip
     quot unless-zero ; inline
 
-: write-random-fasta ( seed n chars floats desc id -- seed )
+TYPED: write-random-fasta ( seed: fixnum n: fixnum chars: byte-array floats: double-array desc id -- seed: fixnum )
     write-description
-    [ make-random-fasta ] 2curry split-lines ; inline
+    '[ _ _ make-random-fasta ] split-lines ;
 
-:: make-repeat-fasta ( k len alu -- k' )
+TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
     alu length :> kn
     len iota [ k + kn mod alu nth-unsafe ] "" map-as print
-    k len + ; inline
+    k len + ;
 
 : write-repeat-fasta ( n alu desc id -- )
     write-description
@@ -81,7 +78,7 @@ CONSTANT: homo-sapiens
         :> alu
         0 :> k!
         [| len | k len alu make-repeat-fasta k! ] split-lines
-    ] ; inline
+    ] ;
 
 : fasta ( n out -- )
     homo-sapiens make-cumulative

extra/benchmark/knucleotide/knucleotide.factor

@@ -14,7 +14,7 @@ IN: benchmark.knucleotide
     CHAR: \n swap remove >upper ;
 
 : handle-table ( inputs n -- )
-    clump
+    <clumps>
     [ histogram >alist sort-values reverse ] [ length ] bi
     '[
         [ first write bl ]
@@ -22,7 +22,7 @@ IN: benchmark.knucleotide
     ] each ;
 
 : handle-n ( input x -- )
-    [ nip ] [ length clump histogram ] 2bi at 0 or "%d\t" printf ;
+    [ nip ] [ length <clumps> histogram ] 2bi at 0 or "%d\t" printf ;
 
 : process-input ( input -- )
     [ 1 handle-table nl ]

extra/benchmark/spectral-norm/spectral-norm.factor

@@ -1,8 +1,8 @@
 ! Factor port of
 ! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
 USING: alien.c-types specialized-arrays kernel math
-math.functions math.vectors sequences prettyprint words hints
+math.functions math.vectors sequences sequences.private
-locals ;
+prettyprint words typed locals ;
 SPECIALIZED-ARRAY: double
 IN: benchmark.spectral-norm
 
@@ -19,13 +19,13 @@ IN: benchmark.spectral-norm
     + 1 + recip ; inline
 
 : (eval-A-times-u) ( u i j -- x )
-    [ swap nth ] [ eval-A ] bi-curry bi* * ; inline
+    [ swap nth-unsafe ] [ eval-A ] bi-curry bi* * ; inline
 
 : eval-A-times-u ( n u -- seq )
     [ (eval-A-times-u) ] inner-loop ; inline
 
 : (eval-At-times-u) ( u i j -- x )
-    [ swap nth ] [ swap eval-A ] bi-curry bi* * ; inline
+    [ swap nth-unsafe ] [ swap eval-A ] bi-curry bi* * ; inline
 
 : eval-At-times-u ( u n -- seq )
     [ (eval-At-times-u) ] inner-loop ; inline
@@ -43,11 +43,9 @@ IN: benchmark.spectral-norm
         [ n eval-AtA-times-u ] keep
     ] times ; inline
 
-: spectral-norm ( n -- norm )
+TYPED: spectral-norm ( n: fixnum -- norm )
     u/v [ v. ] [ norm-sq ] bi /f sqrt ;
 
-HINTS: spectral-norm fixnum ;
-
 : spectral-norm-main ( -- )
     2000 spectral-norm . ;
 

extra/elf/nm/nm-docs.factor

@@ -3,7 +3,7 @@
 USING: elf help.markup help.syntax ;
 IN: elf.nm
 
-HELP: nm
+HELP: elf-nm
 { $values
     { "path" "a pathname string" }
 }
@@ -17,6 +17,7 @@ HELP: print-symbol
 
 ARTICLE: "elf.nm" "ELF nm"
 "The " { $vocab-link "elf.nm" } " vocab prints the values, sections and names of the symbols in a given ELF file. In an ELF executable or shared library, the symbol values are typically their virtual addresses. In a relocatable ELF object, they are section-relative offsets."
+{ $subsections elf-nm }
 ;
 
 ABOUT: "elf.nm"