sequences.generalizations: adding lastn, set-lastn, ?lastn.

diff --git a/basis/sequences/generalizations/generalizations-docs.factor b/basis/sequences/generalizations/generalizations-docs.factor
index 1e1472691308b6470c52f9185e5df1a914d11bed..80f6dc21cf27a6d0594f46c40f744ee20b150362 100644 (file)
--- a/basis/sequences/generalizations/generalizations-docs.factor
+++ b/basis/sequences/generalizations/generalizations-docs.factor
@@ -63,6 +63,33 @@ HELP: set-firstn
 { $description "A generalization of " { $link set-first } " "
 "that sets the first " { $snippet "n" } " elements of a sequence from the top " { $snippet "n" } " elements of the stack." } ;
 
+HELP: lastn
+{ $values { "seq" sequence } { "n" integer } { "elts..." { $snippet "n" } " elements on the datastack" } }
+{ $description "A generalization of " { $link last } " and " { $link last2 }
+" that pushes the last " { $snippet "n" } " elements of a sequence on the stack." }
+{ $examples
+    "Some core words expressed in terms of " { $link firstn } ":"
+    { $table
+        { { $link last } { $snippet "1 lastn" } }
+        { { $link last2 } { $snippet "2 lastn" } }
+    }
+} ;
+
+HELP: ?lastn
+{ $values { "seq" sequence } { "n" integer } { "elts..." { $snippet "n" } " elements on the datastack" } }
+{ $description "A generalization of " { $link ?last } " that pushes the last " { $snippet "n" } " elements of a sequence on the stack, or " { $link f } " if the sequence is shorter than the requested number of elements." }
+{ $examples
+    "Some core words expressed in terms of " { $link ?firstn } ":"
+    { $table
+        { { $link ?last } { $snippet "1 ?lastn" } }
+    }
+} ;
+
+HELP: set-lastn
+{ $values { "elts..." { $snippet "n" } " elements on the datastack" } { "seq" sequence } { "n" integer } }
+{ $description "A generalization of " { $link set-last }
+" that sets the last " { $snippet "n" } " elements of a sequence from the top " { $snippet "n" } " elements of the stack." } ;
+
 HELP: nappend
 { $values
     { "n" integer }

diff --git a/basis/sequences/generalizations/generalizations-tests.factor b/basis/sequences/generalizations/generalizations-tests.factor
index 2e0c2150c3bf18efdb2079f6c543a0783b821cf2..6e54c28e2300222d2f3ce66aff85c85897ece7da 100644 (file)
--- a/basis/sequences/generalizations/generalizations-tests.factor
+++ b/basis/sequences/generalizations/generalizations-tests.factor
@@ -17,6 +17,21 @@ IN: sequences.generalizations.tests
 { 1 2 } [ { 1 2 } 2 ?firstn ] unit-test
 { 1 2 } [ { 1 2 3 } 2 ?firstn ] unit-test
 
+[ f 2 lastn ] must-fail
+[ { 1 } 2 lastn ] must-fail
+{ 1 2 } [ { 1 2 } 2 lastn ] unit-test
+{ 2 3 } [ { 1 2 3 } 2 lastn ] unit-test
+
+{ } [ f 0 ?lastn ] unit-test
+{ 1 } [ { 1 } 1 ?lastn ] unit-test
+{ f 1 } [ { 1 } 2 ?lastn ] unit-test
+{ 1 2 } [ { 1 2 } 2 ?lastn ] unit-test
+{ 2 3 } [ { 1 2 3 } 2 ?lastn ] unit-test
+
+{ { f f 1 } } [ 1 { f f f } [ 1 set-lastn ] keep ] unit-test
+{ { f 1 2 } } [ 1 2 { f f f } [ 2 set-lastn ] keep ] unit-test
+{ { 1 2 3 } } [ 1 2 3 { f f f } [ 3 set-lastn ] keep ] 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 2abe30377ec26f3f67fd1ec62af5ed16d295c248..c0add96e78341feb0f7acdfe9ca08385dc8a2c56 100644 (file)
--- a/basis/sequences/generalizations/generalizations.factor
+++ b/basis/sequences/generalizations/generalizations.factor
@@ -38,6 +38,15 @@ MACRO: set-firstn ( n -- quot )
 MACRO: ?firstn ( n -- quot )
     dup '[ _ f pad-tail _ firstn-unsafe ] ;
 
+: lastn ( seq n -- elts... )
+    [ tail-slice* ] [ firstn-unsafe ] bi ; inline
+
+: ?lastn ( seq n -- elts... )
+    [ f pad-head ] [ lastn ] bi ; inline
+
+: set-lastn ( elts... seq n -- )
+    [ tail-slice* ] [ set-firstn-unsafe ] bi ; inline
+
 : nappend ( n -- seq ) narray concat ; inline
 
 : nappend-as ( n exemplar -- seq )

diff --git a/extra/gml/runtime/runtime.factor b/extra/gml/runtime/runtime.factor
index 374a96ee9171a9360481abe0f8bb48cdb0eee103..d6737fcba6ccdd987aa769fe0f55ba18647ce2df 100644 (file)
--- a/extra/gml/runtime/runtime.factor
+++ b/extra/gml/runtime/runtime.factor
@@ -143,17 +143,10 @@ ERROR: gml-stack-underflow ;
 : check-stack ( seq n -- seq n )
     2dup swap length > [ gml-stack-underflow ] when ; inline
 
-: lastn ( seq n -- elts... )
-    check-stack
-    [ tail-slice* ] keep firstn-unsafe ; inline
-
 : popn ( seq n -- elts... )
     check-stack
     [ lastn ] [ over length swap - swap shorten ] 2bi ; inline
 
-: set-lastn ( elts... seq n -- )
-    [ tail-slice* ] keep set-firstn-unsafe ; inline
-
 : pushn ( elts... seq n -- )
     [ over length + swap lengthen ] 2keep set-lastn ; inline