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

basis/math/vectors/vectors-tests.factor

@@ -5,3 +5,7 @@ USING: math.vectors tools.test ;
 [ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
 [ { 1 2 3 } ] [ { 2 4 6 } 2 v/n ] unit-test
 [ { 1/1 1/2 1/3 } ] [ 1 { 1 2 3 } n/v ] unit-test
+
+[ 5 ] [ { 1 2 } norm-sq ] unit-test
+[ 13 ] [ { 2 3 } norm-sq ] unit-test
+

basis/math/vectors/vectors.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel sequences math math.functions hints
 math.order ;
@@ -19,8 +19,8 @@ IN: math.vectors
 : vmax ( u v -- w ) [ max ] 2map ;
 : vmin ( u v -- w ) [ min ] 2map ;
 
-: v. ( u v -- x ) 0 [ * + ] 2reduce ;
+: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
-: norm-sq ( v -- x ) 0 [ absq + ] reduce ;
+: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
 : norm ( v -- x ) norm-sq sqrt ;
 : normalize ( u -- v ) dup norm v/n ;
 

basis/sorting/human/authors.txt

@@ -0,0 +1,2 @@
+Doug Coleman
+Slava Pestov

basis/sorting/human/human-tests.factor

@@ -0,0 +1,6 @@
+USING: sorting.human tools.test ;
+IN: sorting.human.tests
+
+\ human-sort must-infer
+
+[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test

basis/sorting/human/human.factor

@@ -0,0 +1,10 @@
+! Copyright (C) 2008 Doug Coleman, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: peg.ebnf math.parser kernel assocs sorting ;
+IN: sorting.human
+
+: find-numbers ( string -- seq )
+    [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
+
+: human-sort ( seq -- seq' )
+    [ dup find-numbers ] { } map>assoc sort-values keys ;

basis/sorting/human/summary.txt

@@ -0,0 +1 @@
+Correct sorting of sequences of strings with embedded numbers

basis/sorting/human/tags.txt

@@ -0,0 +1,2 @@
+collections
+text

core/kernel/kernel-docs.factor

@@ -550,7 +550,7 @@ HELP: 2bi
 
 HELP: 3bi
 { $values { "x" object } { "y" object } { "z" object } { "p" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } }
-{ $description "Applies " { $snippet "p" } " to the two input values, then applies " { $snippet "q" } " to the two input values." }
+{ $description "Applies " { $snippet "p" } " to the three input values, then applies " { $snippet "q" } " to the three input values." }
 { $examples
     "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y z -- )" } ", then the following two lines are equivalent:"
     { $code

core/sequences/sequences-tests.factor

@@ -265,4 +265,6 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
 
 [ { 1 3 7 } ] [ 2 { 1 3 5 7 } remove-nth ] unit-test
 
-[ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] unit-test
+[ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] 
+
+[ V{ 0 2 } ] [ "a" { "a" "b" "a" } indices ] unit-test

core/sequences/sequences.factor

@@ -480,6 +480,11 @@ PRIVATE>
 : last-index-from ( obj i seq -- n )
     rot [ = ] curry find-last-from drop ;
 
+: indices ( obj seq -- indices )
+    V{ } clone spin
+    [ rot = [ over push ] [ drop ] if ]
+    curry each-index ;
+
 : nths ( seq indices -- seq' )
     swap [ nth ] curry map ;
 
@@ -747,6 +752,17 @@ PRIVATE>
 : unclip-slice ( seq -- rest first )
     [ rest-slice ] [ first ] bi ; inline
 
+: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 )
+    [ unclip-slice ] bi@ swapd ; inline
+
+: map-reduce ( seq map-quot reduce-quot -- result )
+    [ [ unclip-slice ] dip [ call ] keep ] dip
+    compose reduce ; inline
+
+: 2map-reduce ( seq1 seq2 map-quot reduce-quot -- result )
+    [ [ 2unclip-slice ] dip [ call ] keep ] dip
+    compose 2reduce ; inline
+
 : unclip-last-slice ( seq -- butlast last )
     [ but-last-slice ] [ peek ] bi ; inline
 

extra/sequences/lib/lib-tests.factor

@@ -10,9 +10,6 @@ IN: sequences.lib.tests
 { { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
 [ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
 
-[ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
-[ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
-
 [ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test
 [ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test
 

extra/sequences/lib/lib.factor

@@ -31,9 +31,6 @@ IN: sequences.lib
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: map-reduce ( seq map-quot reduce-quot -- result )
-    >r [ unclip ] dip [ call ] keep r> compose reduce ; inline
-
 : reduce* ( seq quot -- result ) [ ] swap map-reduce ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -134,23 +131,6 @@ PRIVATE>
 : power-set ( seq -- subsets )
     2 over length exact-number-strings swap [ switches ] curry map ;
 
-: cut-find ( seq pred -- before after )
-    dupd find drop dup [ cut ] when ;
-
-: cut3 ( seq pred -- first mid last )
-    [ cut-find ] keep [ not ] compose cut-find ;
-
-: (cut-all) ( seq pred quot -- )
-    [ >r cut3 r> dip >r >r , r> [ , ] when* r> ] 2keep
-    pick [ (cut-all) ] [ 3drop ] if ;
-
-: cut-all ( seq pred quot -- first mid last )
-    [ (cut-all) ] { } make ;
-
-: human-sort ( seq -- newseq )
-    [ dup [ digit? ] [ string>number ] cut-all ] { } map>assoc
-    sort-values keys ;
-
 : ?first ( seq -- first/f ) 0 swap ?nth ; inline
 : ?second ( seq -- second/f ) 1 swap ?nth ; inline
 : ?third ( seq -- third/f ) 2 swap ?nth ; inline
@@ -167,14 +147,6 @@ USE: continuations
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! List the positions of obj in seq
-
-: indices ( seq obj -- seq )
-  >r dup length swap r>
-  [ = [ ] [ drop f ] if ] curry
-  2map
-  sift ;
-
 <PRIVATE
 : (attempt-each-integer) ( i n quot -- result )
     [