From f36ec3f0c5da15143f2f6bd1ab3ca88006f14255 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 7 Feb 2009 23:04:55 -0600 Subject: [PATCH] Add nsum, nspread and nweave to generalizations --- .../generalizations-docs.factor | 52 +++++++++++++++---- .../generalizations-tests.factor | 9 ++++ basis/generalizations/generalizations.factor | 19 ++++++- 3 files changed, 67 insertions(+), 13 deletions(-) diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 912f69587e..ac8e14c05a 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -30,6 +30,10 @@ HELP: narray { nsequence narray } related-words +HELP: nsum +{ $values { "n" integer } } +{ $description "Adds the top " { $snippet "n" } " stack values." } ; + HELP: firstn { $values { "n" integer } } { $description "A generalization of " { $link first } ", " @@ -238,6 +242,11 @@ HELP: ncleave } } ; +HELP: nspread +{ $values { "quots" "a sequence of quotations" } { "n" integer } } +{ $description "A generalization of " { $link spread } " that can work for any quotation arity." +} ; + HELP: mnswap { $values { "m" integer } { "n" integer } } { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." } @@ -250,6 +259,17 @@ HELP: mnswap } } ; +HELP: nweave +{ $values { "n" integer } } +{ $description "Copies the top " { $snippet "n" } " stack elements underneath each one of the " { $snippet "n" } " elements below." } +{ $examples + { $example + "USING: arrays kernel generalizations prettyprint ;" + "\"e1\" \"e2\" \"o1\" \"o2\" 2 nweave [ 3array ] 3dip 3array 2array ." + "{ { \"e1\" \"o1\" \"o2\" } { \"e2\" \"o1\" \"o2\" } }" + } +} ; + HELP: n*quot { $values { "n" integer } { "seq" sequence } @@ -299,18 +319,14 @@ HELP: ntuck } { $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 " -"input parameter." -$nl -"Generalized sequence operations:" +ARTICLE: "sequence-generalizations" "Generalized sequence operations" { $subsection narray } { $subsection nsequence } { $subsection firstn } { $subsection nappend } -{ $subsection nappend-as } -"Generated stack shuffle operations:" +{ $subsection nappend-as } ; + +ARTICLE: "shuffle-generalizations" "Generalized shuffle words" { $subsection ndup } { $subsection npick } { $subsection nrot } @@ -319,14 +335,28 @@ $nl { $subsection ndrop } { $subsection ntuck } { $subsection mnswap } -"Generalized combinators:" +{ $subsection nweave } ; + +ARTICLE: "combinator-generalizations" "Generalized combinators" { $subsection ndip } { $subsection nslip } { $subsection nkeep } { $subsection napply } { $subsection ncleave } -"Generalized quotation construction:" +{ $subsection nspread } ; + +ARTICLE: "other-generalizations" "Additional generalizations" { $subsection ncurry } -{ $subsection nwith } ; +{ $subsection nwith } +{ $subsection nsum } ; + +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 " +"input parameter." +{ $subsection "sequence-generalizations" } +{ $subsection "shuffle-generalizations" } +{ $subsection "combinator-generalizations" } +{ $subsection "other-generalizations" } ; ABOUT: "generalizations" diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index 35e02f08b4..7ede271d01 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -53,3 +53,12 @@ IN: generalizations.tests [ 4 nappend ] must-infer [ 4 { } nappend-as ] must-infer + +[ 17 ] [ 3 1 3 3 7 5 nsum ] unit-test +{ 4 1 } [ 4 nsum ] must-infer-as + +[ "e1" "o1" "o2" "e2" "o1" "o2" ] [ "e1" "e2" "o1" "o2" 2 nweave ] unit-test +{ 3 5 } [ 2 nweave ] must-infer-as + +[ { 0 1 2 } { 3 5 4 } { 7 8 6 } ] +[ 9 [ ] each { [ 3array ] [ swap 3array ] [ rot 3array ] } 3 nspread ] unit-test \ No newline at end of file diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 4692fd20db..9b2b2456c2 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo +! Copyright (C) 2007, 2009 Chris Double, Doug Coleman, Eduardo ! Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private math combinators @@ -23,6 +23,9 @@ MACRO: nsequence ( n seq -- ) MACRO: narray ( n -- ) '[ _ { } nsequence ] ; +MACRO: nsum ( n -- ) + 1- [ + ] n*quot ; + MACRO: firstn ( n -- ) dup zero? [ drop [ drop ] ] [ [ [ '[ [ _ ] dip nth-unsafe ] ] map ] @@ -70,11 +73,23 @@ MACRO: ncleave ( quots n -- ) [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi compose ; +MACRO: nspread ( quots n -- ) + over empty? [ 2drop [ ] ] [ + [ [ but-last ] dip ] + [ [ peek ] dip ] 2bi + swap + '[ [ _ _ nspread ] _ ndip @ ] + ] if ; + MACRO: napply ( quot n -- ) swap spread>quot ; MACRO: mnswap ( m n -- ) - 1+ '[ _ -nrot ] spread>quot ; + 1+ '[ _ -nrot ] swap '[ _ _ napply ] ; + +MACRO: nweave ( n -- ) + [ dup [ '[ _ _ mnswap ] ] with map ] keep + '[ _ _ ncleave ] ; : nappend-as ( n exemplar -- seq ) [ narray concat ] dip like ; inline