Merge OneEyed's patch

[factor.git] / core / sequences / sequences.factor

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index ce40f4ae803e6494a150ec8d7c8073f77c0e1629..992f822507c1f80f284a32184d60b9b411b92fce 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -137,9 +137,12 @@ INSTANCE: iota immutable-sequence
 
 : from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
 
+: (1sequence) ( obj seq -- seq )
+    [ 0 swap set-nth-unsafe ] keep ; inline
+
 : (2sequence) ( obj1 obj2 seq -- seq )
     [ 1 swap set-nth-unsafe ] keep
-    [ 0 swap set-nth-unsafe ] keep ; inline
+    (1sequence) ; inline
 
 : (3sequence) ( obj1 obj2 obj3 seq -- seq )
     [ 2 swap set-nth-unsafe ] keep
@@ -151,6 +154,9 @@ INSTANCE: iota immutable-sequence
 
 PRIVATE>
 
+: 1sequence ( obj exemplar -- seq )
+    1 swap [ (1sequence) ] new-like ; inline
+
 : 2sequence ( obj1 obj2 exemplar -- seq )
     2 swap [ (2sequence) ] new-like ; inline
 
@@ -410,7 +416,7 @@ PRIVATE>
     over map-into ; inline
 
 : accumulate ( seq identity quot -- final newseq )
-    swapd [ pick slip ] curry map ; inline
+    swapd [ [ call ] [ 2drop ] 3bi ] curry map ; inline
 
 : 2each ( seq1 seq2 quot -- )
     (2each) each-integer ; inline
@@ -475,14 +481,14 @@ PRIVATE>
 : accumulator ( quot -- quot' vec )
     V{ } clone [ [ push ] curry compose ] keep ; inline
 
-: produce-as ( pred quot tail exemplar -- seq )
-    [ swap accumulator [ swap while ] dip ] dip like ; inline
+: produce-as ( pred quot exemplar -- seq )
+    [ accumulator [ while ] dip ] dip like ; inline
 
-: produce ( pred quot tail -- seq )
+: produce ( pred quot -- seq )
     { } produce-as ; inline
 
 : follow ( obj quot -- seq )
-    [ dup ] swap [ keep ] curry [ ] produce nip ; inline
+    [ dup ] swap [ keep ] curry produce nip ; inline
 
 : prepare-index ( seq quot -- seq n quot )
     [ dup length ] dip ; inline
@@ -819,7 +825,8 @@ PRIVATE>
     [ but-last-slice ] [ peek ] bi ; inline
 
 : <flat-slice> ( seq -- slice )
-    dup slice? [ { } like ] when 0 over length rot <slice> ;
+    dup slice? [ { } like ] when
+    [ drop 0 ] [ length ] [ ] tri <slice> ;
     inline
 
 <PRIVATE
@@ -860,7 +867,8 @@ PRIVATE>
 
 : supremum ( seq -- n ) [ ] [ max ] map-reduce ;
 
-: sigma ( seq quot -- n ) [ 0 ] 2dip [ rot slip + ] curry each ; inline
+: sigma ( seq quot -- n )
+    [ 0 ] 2dip [ dip + ] curry [ swap ] prepose each ; inline
 
 : count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline