diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 9fde1fd1b1..a676be3be8 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -259,6 +259,55 @@ HELP: mnswap } } ; +HELP: n*quot +{ $values + { "n" integer } { "seq" sequence } + { "seq'" sequence } +} +{ $examples + { $example "USING: generalizations prettyprint math ;" + "3 [ + ] n*quot ." + "[ + + + ]" + } +} +{ $description "Construct a quotation containing the contents of " { $snippet "seq" } " repeated " { $snippet "n"} " times." } ; + +HELP: nappend +{ $values + { "n" integer } + { "seq" sequence } +} +{ $description "Outputs a new sequence consisting of the elements of the top " { $snippet "n" } " sequences from the datastack in turn." } +{ $errors "Throws an error if any of the sequences contain elements that are not permitted in the sequence type of the first sequence." } +{ $examples + { $example "USING: generalizations prettyprint math ;" + "{ 1 2 } { 3 4 } { 5 6 } { 7 8 } 4 nappend ." + "{ 1 2 3 4 5 6 7 8 }" + } +} ; + +HELP: nappend-as +{ $values + { "n" integer } { "exemplar" sequence } + { "seq" sequence } +} +{ $description "Outputs a new sequence of type " { $snippet "exemplar" } " consisting of the elements of the top " { $snippet "n" } " sequences from the datastack in turn." } +{ $errors "Throws an error if any of the sequences contain elements that are not permitted in the sequence type of the first sequence." } +{ $examples + { $example "USING: generalizations prettyprint math ;" + "{ 1 2 } { 3 4 } { 5 6 } { 7 8 } 4 V{ } nappend-as ." + "V{ 1 2 3 4 5 6 7 8 }" + } +} ; + +{ nappend nappend-as } related-words + +HELP: ntuck +{ $values + { "n" integer } +} +{ $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ; + ARTICLE: "generalizations" "Generalized shuffle words and combinators" "The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in " "macros where the arity of the input quotations depends on an " @@ -268,6 +317,8 @@ $nl { $subsection narray } { $subsection nsequence } { $subsection firstn } +{ $subsection nappend } +{ $subsection nappend-as } "Generated stack shuffle operations:" { $subsection ndup } { $subsection npick } @@ -275,6 +326,7 @@ $nl { $subsection -nrot } { $subsection nnip } { $subsection ndrop } +{ $subsection ntuck } { $subsection nrev } { $subsection mnswap } "Generalized combinators:" diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index 4eb4c4e686..35e02f08b4 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -5,6 +5,7 @@ IN: generalizations.tests { 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test { 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test { 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test + [ 1 1 ndup ] must-infer { 1 1 } [ 1 1 ndup ] unit-test { 1 2 1 2 } [ 1 2 2 ndup ] unit-test @@ -22,6 +23,8 @@ IN: generalizations.tests { 4 } [ 1 2 3 4 3 nnip ] unit-test [ 1 2 3 4 4 ndrop ] must-infer { 0 } [ 0 1 2 3 4 4 ndrop ] unit-test +[ [ 1 ] 5 ndip ] must-infer +[ 1 2 3 4 ] [ 2 3 4 [ 1 ] 3 ndip ] unit-test [ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer { 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test @@ -44,3 +47,9 @@ IN: generalizations.tests [ 4 5 1 2 3 ] [ 1 2 3 4 5 2 3 mnswap ] unit-test [ 1 2 3 4 5 6 ] [ 1 2 3 4 5 6 2 4 mnswap 4 2 mnswap ] unit-test + +[ { 1 2 3 4 } ] [ { 1 } { 2 } { 3 } { 4 } 4 nappend ] unit-test +[ V{ 1 2 3 4 } ] [ { 1 } { 2 } { 3 } { 4 } 4 V{ } nappend-as ] unit-test + +[ 4 nappend ] must-infer +[ 4 { } nappend-as ] must-infer diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index a447d5c706..b3b4c9b11c 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -2,7 +2,8 @@ ! Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private math math.ranges -combinators macros quotations fry ; +combinators macros quotations fry macros locals datastack +multiline ; IN: generalizations << @@ -78,3 +79,8 @@ MACRO: napply ( quot n -- ) MACRO: mnswap ( m n -- ) 1+ '[ _ -nrot ] spread>quot ; + +: nappend-as ( n exemplar -- seq ) + [ narray concat ] dip like ; inline + +: nappend ( n -- seq ) narray concat ; inline