sequences.generalizations: adding ?firstn.

diff --git a/basis/sequences/generalizations/generalizations-docs.factor b/basis/sequences/generalizations/generalizations-docs.factor
index 12668822ad540521db70f4daad875c47bbaa0091..0f012e621f97184f93b666ca8c139c0e25b57fbb 100644 (file)
--- a/basis/sequences/generalizations/generalizations-docs.factor
+++ b/basis/sequences/generalizations/generalizations-docs.factor
@@ -48,6 +48,10 @@ HELP: firstn
     }
 } ;
 
+HELP: ?firstn
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link ?first } " that pushes the first " { $snippet "n" } " elements of a sequence on the stack, or " { $link f }  " if the sequence is shorter than the requested number of elements." } ;
+
 HELP: set-firstn
 { $values { "n" integer } }
 { $description "A generalization of " { $link set-first } " "

diff --git a/basis/sequences/generalizations/generalizations-tests.factor b/basis/sequences/generalizations/generalizations-tests.factor
index 55513bedbad180893d96fcc4f4f445875629a0e0..1e384cd276a2c5f5d52e59b662d03ede3d54ff7a 100644 (file)
--- a/basis/sequences/generalizations/generalizations-tests.factor
+++ b/basis/sequences/generalizations/generalizations-tests.factor
@@ -10,6 +10,13 @@ IN: sequences.generalizations.tests
 { } [ { } 0 firstn ] unit-test
 { "a" } [ { "a" } 1 firstn ] unit-test
 
+{ } [ { } 0 ?firstn ] unit-test
+{ f } [ { } 1 ?firstn ] unit-test
+{ f f } [ { } 2 ?firstn ] unit-test
+{ 1 f } [ { 1 } 2 ?firstn ] unit-test
+{ 1 2 } [ { 1 2 } 2 ?firstn ] unit-test
+{ 1 2 } [ { 1 2 3 } 2 ?firstn ] unit-test
+
 { [ 1 2 ] } [ 1 2 2 [ ] nsequence ] unit-test
 { { 1 2 3 4 5 } } [ 1 2 3 4 5 { 0 0 0 0 0 } 5 (nsequence) ] unit-test
 

diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor
index 5290e60777c195b0708bc832dd64466728466f16..49a43c9c19a21720835408b4598b74faf16cd4b9 100644 (file)
--- a/basis/sequences/generalizations/generalizations.factor
+++ b/basis/sequences/generalizations/generalizations.factor
@@ -36,6 +36,9 @@ MACRO: set-firstn ( n -- quot )
         bi-curry '[ _ _ bi ]
     ] if-zero ;
 
+MACRO: ?firstn ( n -- quot )
+    dup '[ _ f pad-tail _ firstn-unsafe ] ;
+
 : nappend ( n -- seq ) narray concat ; inline
 
 : nappend-as ( n exemplar -- seq )