add a set-firstn generalization

diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index e3a7c2d7e4bbe421be0baf42182f96b6c4000ca9..de74dd1ead6585412eb19799280405da931b42c6 100644 (file)
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -50,6 +50,11 @@ HELP: firstn
     }\r
 } ;\r
 \r
+HELP: set-firstn\r
+{ $values { "n" integer } }\r
+{ $description "A generalization of " { $link set-first } " "\r
+"that sets the first " { $snippet "n" } " elements of a sequence from the top " { $snippet "n" } " elements of the stack." } ;\r
+\r
 HELP: npick\r
 { $values { "n" integer } }\r
 { $description "A generalization of " { $link dup } ", "\r
@@ -257,7 +262,7 @@ HELP: nweave
 HELP: n*quot\r
 { $values\r
      { "n" integer } { "quot" quotation }\r
-     { "quot'" quotation }\r
+     { "quotquot" quotation }\r
 }\r
 { $examples\r
     { $example "USING: generalizations prettyprint math ;"\r
@@ -314,6 +319,7 @@ ARTICLE: "sequence-generalizations" "Generalized sequence operations"
     narray\r
     nsequence\r
     firstn\r
+    set-firstn\r
     nappend\r
     nappend-as\r
 } ;\r

diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index f95ba632281b219545beb4b3ddfa18a1d1d9a97b..d466d562519b5b6997a000e90800d716e43e7f46 100644 (file)
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -40,6 +40,8 @@ IN: generalizations.tests
 [ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test\r
 \r
 [ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test\r
+[ { 1 2 3 4 } ] [ 1 2 3 4 { f f f f } [ 4 set-firstn ] keep ] unit-test\r
+[ 1 2 3 4 { f f f } [ 4 set-firstn ] keep ] must-fail\r
 [ ] [ { } 0 firstn ] unit-test\r
 [ "a" ] [ { "a" } 1 firstn ] unit-test\r
 \r

diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 5ca00018a24320dd43523dd02ce215f069b4e580..2e9d560ae61a6f98686d94fbf4fc65452cec0274 100644 (file)
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -48,6 +48,18 @@ MACRO: nrot ( n -- )
 MACRO: -nrot ( n -- )
     1 - [ ] [ '[ swap _ dip ] ] repeat ;
 
+MACRO: set-firstn-unsafe ( n -- )
+    [ 1 + ]
+    [ iota [ '[ _ rot [ set-nth-unsafe ] keep ] ] map ] bi
+    '[ _ -nrot _ spread drop ] ;
+
+MACRO: set-firstn ( n -- )
+    dup zero? [ drop [ drop ] ] [
+        [ 1 - swap bounds-check 2drop ]
+        [ set-firstn-unsafe ]
+        bi-curry '[ _ _ bi ]
+    ] if ;
+
 MACRO: ndrop ( n -- )
     [ drop ] n*quot ;